2015 年 以 来 ，Al、 机 器 学 习 、 深 度 学 习 等 概念 无 疑 成 为 整个 互联 网 行业 甚至 整个 社会 最 火热 的 概念 。 无 论 是 Alpha Go 以 挫 
枯 拉 配 乙 努 战 胜 所 有 人 类 选手 ， 宣 告 厦 “ 围 棋 乙 神 ” 的 降临 ;还 是 Tesla、QGoogle、 百 大 等 互联 网 巨头 在 目 动 轨 驶 领域 投入 重金 
以 抢夺 这 个 AI 时 代 最 大 的 行业 风口 ， 抑 或 是 Geoff Hinton. REA, F € 《等 机 器 学 习 领 域 的 奢 名 学 者 纷纷 走出 校园 ， 投 奔 业 
春 。 这 些 都 意味 着 机 器 学 习 早已 不 再 是 仪 仅 被 象牙 塔 中 的 学 者 教授 们 谈 及 的 冷门 学 科 ， 而 是 终 将 走 到 每 个 人 的 身边 ， 影 响 每 个 人 
的 生活 ， 甚 至 改变 整个 社会 生产 生活 方式 的 科技 革命 。 


对 于 所 有 的 IT 行 业 从 业者 来 说 ， 机 器 学 习 也 是 一 场 思维 方式 的 变革 。 所 有 主流 的 互利 网 公司 甚至 是 传统 行业 的 优秀 公司 都 越 
来 越 重视 数据 的 重要 性 ， 通 过 算法 和 机 器 学 习 模 型 来 挖 握 数据 中 的 价值 ， 以 驱动 公司 业务 的 进一步 增长 。 与 此 同时 ， 越 来 越 多 的 
从 业者 转型 成 数据 科学 家 、 算 法 工程 师 ， 走 在 这 场 变革 的 最 前 治 。 对 于 刚刚 走出 校园 的 应 届 生 来 说 ， 无 论 是 计算 机 相关 专业 ， 还 
是 数学 、 物 理 等 基础 专业 ， 抑 或 是 生物 、 化 学 等 应 用 学 科 专 业 ， 也 都 纷纷 拥抱 这 场 由 数据 和 算法 和 市 来 的 革命 ， 成 为 Al 业 界 的 新 鲜 
血液 。 


我 是 一 名 有 五 年 工作 经 验 的 算法 工程 师 ， 在 我 工作 的 计算 广告 领域 ， 也 切身 感受 到 行业 友 展 之 快 ， 变 化 之 迅速 ， 以 及 人 才 需 
求 之 担 切 。2015 年 之 前 ,算法 工程 师 这 个 “title” 还 是 各 个 公司 的 小 众 群体 ， 但 时 至 2017 年 ， 优 秀 的 算法 工程 师 已 经 成 为 各 大 
公司 最 火热 也 最 紧缺 的 职位 ， 而 拥有 优秀 算法 工程 师 的 公司 也 因此 大 放 异 彩 ， 像 今日 头条 的 推荐 ， 滴 泣 的 运筹 规划 ， 阿 里 的 广告 
算法 ， 都 让 其 公司 成 为 各 目 领 域 当之无愧 的 巨头 。 但 在 招聘 和 工作 的 过 程 中 ， 我 也 上 友 现 了 诸多 不 好 的 现象 ， 许 多 工程 师 和 应 届 生 
急于 转行 ， 忽 视 了 算法 和 统计 学 的 基础 ， 也 有 很 多 算法 工程 师 对 于 算法 和 模型 的 态度 不 够 严谨 ， 知 其 然而 不 知 其 所 以 然 ， 不 能 将 
公司 业务 与 算法 更 好 地 结合 起 来 ， 这 些 都 成 为 阻碍 算法 工程 师 成 长 的 绊脚石 。 这 也 是 我 翻译 本 书 的 原因 和 动力 ， 一 本 将 机 器 学 
习 、 统 计 学 基础 和 实际 数据 、 实 际 分 析 工 具 结 合 起 来 的 优秀 参考 书 ， 能 够 极 大 提高 我 们 的 理论 功底 和 动手 水 平 。 我 目 己 在 阅读 原 
著 并 完成 原著 实例 的 过 程 中 受益 菲 浅 ， 也 希望 通过 翻译 本 书 让 更 多 的 从 业者 、 有 志 于 算法 领域 的 在 校生 受益 。 


本 书 作者 在 机 器 学 习 领 域 拥有 超过 11 年 的 从 业经 历 ， 并 在 量化 投资 、 图 像 处 理 、 上 自然 语言 处 理 等 多 个 领域 拥有 让 语 的 研究 
和 开 友 经 验 。 从 他 的 书 中 ， 你 明显 可 以 友 现 “理论 联系 实际 ”的 特点 。 无 论 是 使 用 隐 马 尔 可 夫 模 型 构建 量化 交易 案 略 ， 还 是 使 用 
决策 树 模型 构建 疾病 护理 体系 ， 在 介绍 每 种 模型 时 ， 作 者 都 会 结合 实际 问题 ， 用 R 语 言 实 现 并 进行 多 维度 的 分 析 。 人 在 翻译 本 书 的 
HJ, 我 也 感 党 到 读者 需要 颇 深 的 统计 学 背景 ， 力 图 用 更 偏 统计 学 的 语言 拉 述 算法 模型 ， 所 使 用 的 R 语 言 也 更 多 流行 于 学 术科 人 研 
和 数据 分 析 的 领域 。 对 于 很 多 计算 机 背景 的 读者 来 说 ， 本 书 是 一 个 很 好 地 熟悉 统计 学 知识 和 R 语 言 的 机 会 。 


本 书 是 我 与 清华 大 学 计算 机 系 博士 曹 建 勋 一 同 炎 译 的 ， 我 们 的 合作 非常 愉快 。 最 后 ， 感 谢 本 书 的 策划 编辑 张 锡 鹏 和 责任 编辑 
缪 杰 在 翻译 过 程 中 提供 的 诸多 帮助 。 


由 于 译 者 水 平 有 限 ， 译 文 难免 有 错误 之 处 ， 欢 迎 读者 批评 指正 。 


2017 年 10 月 31 日 于 北京 


当今 世界 ， 数 据 已 经 成 为 新 的 “价值 金 矿 ” 并 以 指数 级 的 速度 增长 着 。 这 种 增长 既 包 括 现存 数据 的 增长 ， 也 包括 新 数据 的 增 
长 ， 这 些 新 的 数据 以 结构 化 和 非 结 构 化 的 形式 展现 ， 并 来 源 于 社交 媒体 、 互 联网 、 文 档 文 献 以 及 物 联 网 等 多 种 多 样 的 数据 兰 。 数 
据 流 必须 实时 地 收集 、 处 理 、 分 析 ， 并 最 终 展现 出 来 以 确保 数据 的 使 用 者 能 够 在 如 今 快 速 变 化 的 环境 中 做 出 理性 且 明 智 的 决定 。 
机 器 学 习 技 术 将 待 解决 问题 的 上 下 文 信息 应 用 于 这 些 数 据 上 ， 用 统计 学 技术 确保 不 断 快速 到 达 的 复杂 数据 能 够 以 科学 的 方式 加 以 
分 析 。 并 利用 机 器 学 习 算 法 从 数据 中 进行 进 代 学 习 ， 友 现 数据 中 的 隐藏 模式 和 规律 。 机 器 学 习 的 这 种 迭代 学 习 的 模式 是 非 音 重 要 
的 ， 正 因 如 此 ， 当 机 器 学 习 模 型 被 暴露 在 新 的 数据 中 时 ， 它 们 才能 从 新 的 数据 集中 独立 地 适应 和 学 习 以 产 出 可 靠 的 结论 。 


我 们 将 首先 介绍 本 书 中 包含 的 多 种 不 同 的 机 器 学 习 主 题 ， 随 后 ， 基 于 现实 世界 的 问题 在 不 同 的 草 节 中 对 各 个 主题 进行 一 一 探 
讨 ， 例 如 分 类 、 聚 类 、 模 型 选择 和 正则 化 、 非 线性 问题 、 监 督学 习 、 无 监督 学 习 、 增 强 学 习 、 结 构 化 预测 、 神 经 网 络 、 深 度 学 
习 ， 还 有 最 后 的 案例 研究 。 本 书 的 机 器 学 习 算 法 以 R 语 言 作为 编程 语言 。 本 书 适 用 于 Ri 语言 的 初学 者 ， 但 是 熟悉 R 语 言 对 理解 和 使 
用 本 书 的 代码 肯定 是 会 有 所 帮助 的 。 


你 将 学 习 如 何 合理 地 决定 使 用 哪 类 算法 以 及 如 何 应 用 这 些 算法 得 到 最 佳 的 效果 。 如 果 你 想 要 对 图 像 、 文 字 、 语 音 或 者 其 他 形 
陈 的 数据 都 建立 有 意义 的 多 功能 的 应 用 ， 本 书 绝对 会 成 为 你 的 得 力 助手 。 


本 书 的 主要 内 容 


第 1 章 涵盖 了 机 器 学 习 的 各 种 概念 。 本 章 使 读者 初步 了 解 本 书 涵 芋 的 各 个 主题 |。 
第 2 草包 括 以 下 算法 : 判别 浮 数 分 析 、 多 元 逻辑 回归 、Tobit 回 归 、 站 松 回归 。 
第 3 草包 括 以 下 主题 和 算法 : 层次 聚 类 、 二 进 制 聚 类 、k 均 值 聚 类 。 

第 4 草包 括 以 下 主题 和 算法 : 压缩 方法 、 降 维 方法 和 主 成 分 分 析 。 

第 5? 章 包括 以 下 主题 和 算法 : 广义 加 性 模型 、 平 滑 样 条 、 局 部 回归 。 

第 6 草包 括 以 下 主题 和 算法 : 决策 树 学 习 、 朴 素 贝 叶 斯 、 随 机 和 森林、 支持 向 量 机 、 随 机 梯度 下 降 。 
第 7 章 包括 以 下 主题 和 和 算法: 目 组 织 映射 和 和 天 量 量化 。 

第 8 章 包括 以 下 主题 和 算法 : 马尔 可 夫 链 、 蒙 特 卡 洛 模拟 。 

第 9 章 包括 以 下 主题 和 算法 : 隐 马 尔 可 夫 模 型 。 

第 10 草 包括 以 下 主题 和 算法 : 神经 网 络 。 

第 11 草 包括 以 下 主题 和 算法 : 递归 神经 网 络 。 

第 12 草 包括 世界 银行 数据 分 析 。 

第 13 章 包括 再 保险 合同 定价 。 


第 14 章 包括 用 电量 预测 。 


本 书 的 重点 


本 书 的 重点 是 用 R 语 言 构建 基于 机 器 学 习 的 应 用 。 我 们 已 经 使 用 R 语 言 构 建 过 各 种 解决 方案 。 我 们 的 重点 是 利用 R 语 言 库 和 阅 
数 以 最 佳 方式 来 克服 现实 世界 的 挑战 。 我 们 尽量 保持 所 有 代码 的 友好 性 和 可 读 性 。 我 们 认为 这 将 使 读者 能 够 很 容易 地 理解 代码 ， 


HETER RPAC. 
本 书 的 目标 读者 

本 书 是 为 想 构 建 实用 的 基于 机 器 学 习 的 应 用 的 专业 人 士 ， 以 及 统计 、 数 据 分 析 、 机 器 学 习 、 计 算 机 科学 或 其 他 专业 的 学 生 和 和 
专业 人 士 准备 的 。 本 书 适用 于 R 语 言 的 初学 者 ， 但 是 熟悉 R 语 言 对 理解 和 使 用 本 书 的 代码 肯定 是 会 有 所 帮助 的 。 对 于 那些 希望 在 
现 有 技术 栈 中 探索 机 器 学 习 技 术 的 有 经 验 的 R 语 言 程 序 员 来 说 ， 本 书 也 将 是 非常 有 用 的 。 
特殊 章节 

在 本 书 中 ， 你 将 频繁 看 到 如 下 小 节 : 准备 工作 和 具体 实施 步骤 。 

为 了 更 加 清晰 地 说 明 怎 样 完成 一 个 机 器 学 习 廊 法 ,我们 使 用 了 如 下 特殊 章节 。 
准备 工作 


该 节 告 诉 你 机 器 学 习 廊 法 需要 哪些 准备 ， 并 摘 述 了 如 何 设置 该 机 器 学 习 方 法 所 要 求 的 软件 或 其 他 先决 条 件 。 


具体 实施 步骤 


` 


该 节 和 包含 了 机 器 学 习 方 法 的 各 个 具体 步 又. 


下 载 示例 代码 


本 书 的 代码 位 于 GitHub 上 ， 读 者 可 从 https://github.com/PacktPublishing/Practical-Machine-Learning-Cookbook 下 
载 。 


下 载 本 书 的 彩 图 
本 书 还 为 你 提供 了 一 个 PDF 文件 ， 其 中 包含 了 本 书 的 彩 图 。 这 些 彩 图 将 帮助 你 更 好 地 理解 输出 的 变化 。 你 能 够 从 地 


tthttps://www.packtpub.com/sites/default/files/downloads/Practical MachineLearningCookbook Colorlmages.pdf F 
载 访 文件。 


本 章 将 介绍 机 器 学 习 及 其 涵 兰 的 多 个 话题 。 你 将 了 解 以 下 内 容 : 


聚 类 方法 概述 

- 模型 的 选择 和 正则 化 概述 
- 非 线 性 方法 概述 

. 监督 学 习 概述 

C 无 监督 学 习 概述 

. 增强 学 习 概 述 
结构 化 预测 概述 


- 神经 网 络 概述 


1.1 什么 是 机 器 学 习 


人 类 目 出 生起 融 暴 露 企 各 种 数据 中 。 有 眼睛、 耳 朱 、 申 子 、 尽 肤 、 天 头 不 断 收集 寿 各 种 形式 的 数据 ， 然 后 大 脑 将 其 转换 成 视 
况 、 听 竞 、 噢 咒 、 触 党 和 味 营 。 大 脑 处 理 各 种 形式 的 感 党 器 官 收 到 的 原始 数据 ， 并 将 其 转换 成 语音 ， 进 而 用 语音 表达 对 于 这 些 原 
IARRI. 


当今 世界 ， 我 们 用 与 机 器 相连 的 传感器 收集 数据 。 从 各 式 各 样 的 网 站 和 社交 网 络 收 集 数据 。 之 前 的 手写 材料 也 在 电子 化 、 数 
字 化 后 锌 加 入 数据 集中 。 这 些 形式 丰富 、 从 不 同 数据 源 中 采集 的 数据 需要 经 过 处 理 才 能 得 到 更 有 洞察 力 的、 更 有 意义 的 结果 。 


机 器 学 习 算法 有 助 于 从 不 同 数据 源 收集 数据 ， 转 换 富 数据 集 的 形式 ， 并 基于 分 析 结果 ， 帮 助 我 们 采取 明智 的 行动 。 机 器 学 习 
算法 是 高 效 、 准 确 的 方法 ， 并 提供 通用 的 学 习 方法 来 解决 以 下 问题 


处 理 大 规模 问题 

-做 出 准确 的 预测 

E 解决 各 种 不 同 的 学 习 问 题 

. 学 习 哪 些 结果 可 以 得 出 ， 以 及 在 何 种 条 件 下 这 些 问 题 能 够 学 习 
机 器 学 习 算 法 的 一 些 应 用 领域 如 下 : 

- 基于 销售 数据 的 价格 预测 

预测 药物 的 分 子 反 应 

“ 检测 汽车 保险 欺诈 

- 分 析 股 市 回报 


-识别 高 风险 贷款 


` 预测 风力 发 电厂 产量 


- 跟踪 和 监测 医疗 保健 设备 的 利用 率 和 位 置 


“计算 能 源 有 效 利用 率 


> 
— 
zh 
zu 
CC 
X 


市 交通 运输 增长 趋势 


. 估算 采矿 业 矿 产 储量 


1.2 分 类 万 冯 慨 述 


线性 回归 模型 本 质 上 进行 量化 的 响应 ， 但 是 这 样 的 响应 本 质 上 是 定性 的 。 束 人像 态度 (强烈 不 同意 ， 不 同意 ， 中 立 ， 同 意 和 强 
烈 同 意 ) 这 样 的 啊 应 ， 其 本 质 上 融 是 定性 的 。 对 于 一 个 观察 来 况 ， 预 测 一 个 定性 的 啊 应 可 以 视 作 对 这 个 观察 进行 分 类 ， 因 为 这 涉 
及 把 这 个 观察 分 配给 一 个 类 别 或 种 类 。 分 类 器 对 于 今天 的 许多 问题 (如 药物 或 基因 组 学 预测 、 志 圾 邮件 检测 、 面 部 识别 和 财务 问 
题 ) 来 说 是 非常 重要 的 工具 。 
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1.3” 聚 类 万 ;去 概述 


聚 类 是 将 相似 对 象 聚合 成 一 艇 的 过 程 。 每 一 个 簇 由 彼此 之 间 相 似 并 且 与 其 他 类 的 对 象 不 相似 的 对 象 组 成 。 聚 类 的 目标 是 确定 
一 组 未 标记 数据 的 内 在 分 组 。 聚 类 可 用 于 数据 挖掘 (DNA 分 析 、 营 销 研 究 、 保 险 研 究 等 ) ， 文 本 挖掘， 信息 检索 ， 统 计 计算 语 
言 学 ， 以 及 基于 语料库 的 计算 词典 学 等 不 同 应 用 领域 。 聚 类 算法 必须 满足 如 下 要 求 : 





` 可 扩展 性 
“ 处 理 各 种 类 型 的 属性 


- AIWA EH IRKI ik 


“ 可 解释 性 和 可 用 性 


石 图 是 聚 类 的 一 个 示例 。 


监督 学 习 需 要 学 习 一 组 输入 变量 (通常 为 向量 ) 和 输出 变量 (也 称 为 监控 信和 号) 之 间 的 映射 ， 并 应 用 此 映射 来 预测 未 知 数据 
的 输出 。 监 督学 习 的 方法 尝试 友 现 输入 变量 和 目标 变量 之 间 的 天 系 。 友 现 的 天 系 在 称 为 “模型 ”的 结构 中 表示 。 通 常 隐藏 在 数据 


集中 的 模型 白 述 和 现象 解释 ， 在 燥 道 输入 属性 的 值 后 ， 这 些 模 型 可 以 用 于 预测 目标 属性 的 什 。 


监督 学 习 是 从 监督 的 训练 数据 (训练 样本 集 ) 推测 函数 的 机 器 学 习 任务 。 训 练 数据 由 一 组 训练 样本 组 成 。 在 监督 学 习 中 ， 每 
个 例子 是 一 组 ， 它 由 一 个 输入 对 象 和 一 个 期 望 的 输出 值 组 成 。 监 督学 习 算法 分 析 训练 数据 并 学 习 出 预测 函数 


为 了 解决 监督 学 习 问 题 ， 必 须 执行 以 下 步骤 : 
1) 确定 训练 样本 的 类 型 。 

2) 收集 训练 集 。 

3) 确定 预测 函数 的 输入 变量 。 

4) 确定 预测 立 数 的 结构 和 相应 的 学 习 算 法 。 
5) 完成 设计 。 


6) 评估 预测 函数 的 准确 性 。 


监督 学 习 的 方法 可 以 应 用 在 各 个 领域 ， 如 市 场 请 销 、 财 务 和 制造 业 。 
在 监督 学 习 中 要 考虑 的 一 些 问题 如 下 : 

“ 权衡 有 偏 变量 

` 荡 数 复杂 性 和 训练 数据 量 

: 输入 空间 的 维度 

E 输出 数据 中 的 噪声 

` 数据 的 异 构 性 

EC Lp I 


. 交互 性 和 非 线性 问题 的 存在 


无 监督 学 习 针对 全 体 输 入 样本 ， 学 习 出 一 种 特定 的 模型 来 表征 输入 样本 整体 的 统计 结构 。 无 监督 学 习 是 重要 的 ， 因 为 它 在 大 
脑 的 学 习 过 程 中 比 监督 学 习 更 常见。 例如， 眼睛 中 光 感 受 器 的 活动 是 随 着 视 膨 世界 而 不 断 变 化 的 。 它 们 持续 提供 可 用 于 显示 世界 
上 有 什么 对 象 、 如 何 呈 现 、 照 明 条 件 怎 样 等 的 所 有 人 信息。 然而， 基本 上 没有 关于 场景 内 容 的 信息 在 视 党 学 习 期 间 是 可 用 的 。 这 整 
使 得 无 监督 的 方法 全 天 重要 ， 并 用 作 适 合 神经 突 触 的 计算 模型 。 


在 无 监督 学 习 中 ， 机 器 接收 输入 ， 但 是 既 没有 有 监督 的 目标 输出 ， 也 没有 从 环境 中 获得 奖励 或 者 有 反馈。 想象 一 下 机 器 在 没有 
得 到 环境 的 任何 反馈 时 可 能 会 学 到 什么 ， 这 似乎 有 些 神秘 。 然 而 ， 建 立 一 个 正式 的 无 监督 学 习 框 架 是 可 行 的 ， 因 为 无 监督 学 习 是 
基于 这 样 的 概念 : 机 器 学 习 的 目标 是 建立 一 种 用 于 决策 制定 、 预 测 未 来 输入 、 高 效 传输 输入 到 其 他 机 器 等 目的 的 输入 的 表示 。 某 
种 意义 上 来 说 ， 可 认为 无 监督 学 习 是 在 上 述 数据 中 友 现 模式 和 规律 ， 并 且 考 虑 噪声 的 影响 。 


无 监督 学 习 的 一 些 目标 如 下 : 


-在 不 需要 目标 输出 的 前 提 下 ， 在 大 型 数据 集中 发 现 有 用 的 结构 。 


. 通过 为 每 个 可 能 的 数据 向 量 分 配 分 数 或 概率 来 构建 数据 向 量 模型 。 


16 ΒΕΔ 


增强 学 习 是 训练 一 个 会 目 我 行动 的 “代理 人 ”来 最 大 化 它 从 世界 中 获取 奖励 的 问题 。 它 是 天 于 如 何 行动 以 及 如 何 将 事件 情 ， 
映射 到 动作 ， 以 最 大 化 量化 的 奖励 信号 的 问题 。 像 大 多 数 机 器 学 习 方 法 一 样 ， 学 习 者 刚 开 始 不 台 道 要 采取 哪些 行动 ， 而 是 要 通过 
尝试 来 友 现 哪 些 行为 能 够 产生 最 大 的 奖励 。 强 化 学 习 的 两 个 最 重要 的 区 别 特征 是 “尝试 ,错误 ,搜索 ”的 过 程 和 延迟 奖励 。 强 化 
学 习 的 一 些 例子 如 下 : 


. 当 一 名 棋 手 思考 下 一 步 棋 时 ， 他 是 通过 计划 下 一 步 可 能 的 反馈 以 及 计数 器 的 反馈 来 做 决策 的 。 


. 自 适 应 控制 器 实时 调整 炼油 厂 的 操作 参数 。 控 制 器 在 指定 边际 成 本 的 基础 上 权衡 优化 收益 /成 本 /质量 ， 而 不 是 严格 遵守 工 


程 师 最 初 建议 的 设 定 参数 。 


. 一 只 瞪 关 在 出 生 后 几 分 钟 就 挣扎 着 站 起 来 。 半 小 时 后 ， 它 已 经 能 够 以 20 英 里 /时 由 奔跑 。 





` 教 一 只 狗 一 个 新 的 技巧 不 告诉 它 做 什么 ， 但 是 如 果 它 做 正确 /错误 的 事情 ， 就 给 它 奖 励 /惩罚 。 它 不 得 不 弄 清 楚 它 如 何 


得 到 奖励 /惩罚 ， 这 称 为 信用 分 配 问题 。 


增强 学 习 残 像 试销 学 习 一 样 。 代 理 人 应 该 从 环境 经 验 中 友 现 展 好 的 荣 略 ， 以 便 在 过 程 中 不 失去 太 多 的 奖励 。 “探索 ” 虽 在 寻 
找 有 关 环 境 的 更 多 信息 ， 而 “利用 ” 叶 在 借助 已 知 信息 来 最 大 化 奖励 。 例 如 : 


“ 餐厅 选择 。 利 用 : 去 你 最 喜欢 的 餐厅 。 探 索 : 尝试 一 个 新 的 餐厅 。 


: 石油 钻探 。 利 用 : 在 最 有 名 的 地 点 进行 钻探 。 探 索 : 在 新 的 位 置 钻探 。 


增强 学 习 的 主要 内 容 如 下 : 


- 策略 : 策略 是 代理 人 的 行为 函数 。 它 确定 从 环境 的 感知 状态 到 所 采取 行为 之 间 的 映射 。 它 对 应 于 心理 学 所 称 的 一 组 刺激 反 
应 规则 或 关联 。 


- 价值 函数 : 价值 函数 是 对 未 来 奖励 的 预测 。 某 个 状态 的 价值 是 从 该 状态 开始 代理 人 期 望 在 未 来 积累 的 奖励 总 额 。 而 奖励 决 
定 了 环境 状态 的 即时 、 内 在 的 可 取 性 ， 价 值 表 示 了 状态 长 期 的 可 取 性 ， 其 中 考虑 了 该 状态 之 后 的 状态 序列 以 及 伴随 这 些 状态 的 奖 
励 。 


ΒΕ; 模型 预测 下 一 步 环境 将 会 如 何 变 化 。 它 预测 下 一 个 状态 和 下 一 个 状态 的 即时 奖励 。 





[1] 1 英里 /时 =0.44704 米 / 秒 。 编辑 注 


1.7 ”结构 化 预测 概述 


结构 化 预测 是 机 器 学 习 问 题 的 重要 应 用 领域 。 考 虑 输入 x 和 输出 y，x 和 y 可 能 是 如 下 类 型 的 数据 : 一 组 标注 过 的 时 间 序 列 , 一 
张 图 片 的 一 组 属性 ， 句 子 的 解析 成 分 ， 或 者 从 一 张 图 片上 分 割 出 的 一 组 对 象 ， 结 构 化 预测 问题 是 很 有 挑战 性 的 ， 因 为 y 是 包含 它 
的 输出 变量 的 数量 的 指数 级 别 。 由 于 预测 需要 搜索 巨大 的 参数 空间 ， 因 此 结构 预测 问题 在 计算 上 是 具有 挑战 性 的 。 因 为 从 有 限 的 
数据 中 学 习 精 确 的 模型 需要 推导 不 同 结构 化 输出 之 间 的 共同 点 ， 所 以 预测 也 需要 统计 方面 的 因素 。 结 构 化 预测 本 质 上 是 一 个 映射 
问题 ， 其 中 映射 必须 捕捉 x 和 y 之 间 的 区 别 性 交互 ， 并 且 还 允许 在 y 上 进行 有 效 的 组 合 优化 。 


















































结构 化 预测 是 天 于 从 输入 数据 中 预测 结构 化 输出 的 问题 ， 不 同 于 只 预测 一 个 数值 的 分 类 或 回归 问题 。 例 如 : 
目 然 语言 处 理 ， 上 自动 翻译 (输出 : 句子 ) 或 句子 解析 (输出: 解析 树 ) ο 

“ 生物 信息 学 ， 二 级 结构 预测 (输出 : 二 分 图 ) 或 酶 功能 预测 (输出 : 树 中 的 路 径 ) ο 

AFLE, Εκ (输出 : 句子 ) 或 文本 转 语音 (输出 : 音频 信号 ) ο 


机器人， 规划 (输出: 动作 顺序 ) ο 


1.8 ”神经 网 络 概 述 


独 经 网 络 代表 了 进行 信息 处 理 的 仿 大 脑 结构 。 这 些 模型 受 生 物 学 的 局 友 ， 而 不 是 大 脑 实际 功能 结构 的 精确 复制 。 神 经 网 络 能 
够 从 数据 中 学 习 的 能 力 很 强 ， 已 证 明 它 是 许多 预测 和 业务 分 类 应 用 场景 中 非常 有 应 用 价值 的 系统 。 


答 入 节点 层 从 出 节点 层 


办 人 xl | 
> 输出 yl 
> 


“输出 y2 
-> 


ta A | XN θα 
jJ x3 | M ES AN M 一 
i 人 Va m | BH TU 


人 工 神 经 网 络 通 过 更 新 网 络 染 构 和 连接 权重 来 学 习 ， 使 网 络 能 够 有 效 地 执行 任务 。 它 可 以 从 可 用 的 训练 模式 中 学 习 ， 或 者 从 
训练 样本 或 输入 一 输出 天 系 中 目 动 学 习 。 学 习 过 程 由 以 下 方式 设计 : 





“了解 可 用 信息 。 

. 学 习 范 例 ， 从 环境 中 获取 模型 。 

-学习 规则 ， 找 出 更 新 权重 的 过 程 。 

学习 算法 ， 通 过 学 习 规 则 确定 调整 权重 的 过 程 。 
学 习 规 则 有 四 种 基本 类 型 : 

- 纠 错 规则 

` k λα 


d 


深度 学 习 是 指 一 组 相当 广泛 的 机 器 学 习 技术 和 染 构 ， 它 们 的 特点 是 使 用 了 多 层 非 线 性 信息 处 理 结构 化 模型 架构 。 深 度 学 习 架 
构 有 三 大 类 : 


J 学 习 各 特征 层 的 特征 


Ισ ο Ες m; m 0, 
WA ὙΠ "PEE LT 


ar ME boc 
T ος "nra. 





无 监督 或 生成 式 深度 学 习 网 络 


本 章 将 涵 芒 如 下 内 容 : 

. 判别 函数 分 析 : ΘΛ hh, ΒΚ 

多 元 还 辑 回归 : 理解 学 生 的 课程 计划 选择 
.Tobit 回 归 : 评估 学 生 的 学 术 能 力 


- 泊 松 回归 : 理解 加 拉 帕 斯 群岛 现存 物种 


τ (Discriminant analysis) 用 来 对 观察 对 象 进行 区 分 并 分 组 ， 进 而 分 配 新 的 观察 对 象 到 先前 定义 好 的 组 中 。 举 例 来 
(1) 灵 长 类 动物 (2) 乌 类 或 (3) 松鼠 食用 的 水 果 ， 研 究 者 可 以 收集 


说， 如 果 进 行 一 项 研究 来 调查 有 哪些 变量 能 够 被 用 来 区 分 


多 个 被 这 三 类 动物 食用 的 水 果 的 特点 。 那 么 大 多 数 水 果 会 目 然 分 到 这 三 类 中 。 判 别 分 析 可 被 用 来 确定 哪些 变量 能 够 最 好 地 预测 一 
种 水 果 是 否 会 被 乌 类 、 灵 长 类 或 者 松鼠 食用 。 此 外 ， 判 别 分 析 还 剃 被 用 于 生物 物种 分 类 ， 医 学 肿瘤 分 类 ， 以 及 信用 卡 和 保险 行业 
的 风险 界定 。 判 别 分 析 的 主要 目标 是 判别 和 分 类 。 关 于 判别 分 析 的 三 个 假设 是 : 各 判别 变量 之 间 具 有 多 元 正 态 分 布 ， 变 量 间 的 低 
多 重 共 续 性 ， 各 组 变量 的 协 方才 矩阵 相等 。 


多 元 逻辑 回归 (Multinomial logistic regression) 基于 多 个 上 自 变 量 ， 预 测 样本 所 在 的 分 类 或 者 分 类 在 某 因 变量 上 的 概率 。 
它 一 般 使 用 在 因 变 量 有 两 个 以 上 名 字 型 分 类 或 无 序 分 类 的 情况 下 ， 而 且 这 种 问题 中 自 变 量 的 虚拟 编码 相当 普遍 。 自 变量 可 以 是 二 
分 的 (二进制 ) 或 连续 的 (区 间或 比例 ) 。 多 元 逻辑 回归 使 用 最 大 似 然 估 计 来 进行 分 类 问题 求解 ， 而 不 是 传统 多 项 式 回 归 中 使 用 
的 最 小 二 乘 估计 。 样 本 概率 分 布 的 一 般 形式 被 事先 假设 ， 在 参数 估计 的 过 程 中 ， 首 先 设 定 参数 的 初 值 ， 在 设 定 的 参数 初 值 下 ， 计 
算 从 事先 假定 分 布 进行 样本 抽样 的 似 然 值 。 该 过 程 被 迭代 进行 直到 在 某 个 参数 估计 下 得 到 最 大 似 然 值 。 


Tobit 回 归 (Tobit regression) 是 用 来 描述 非 负 目 变量 和 因 变 量 之 间 关 系 的 。 它 也 被 称 为 审查 回归 模型 。 访 模型 被 设计 用 
来 在 因 变量 存在 或 左 或 右 的 删 齐 时 估计 变量 之 间 的 线性 天 系 。 因 变量 删 剪 友 生 在 下 面 的 情况 下 ， 当 一 个 变量 的 值 等 于 或 者 高 于 某 
个 阅 值 时 ， 访 变量 取 值 为 该 阐 值 ， 所 以 变量 的 真实 值 可 能 等 于 该 阅 值 ， 也 可 能 高 于 该 阐 值 。Tobit 模 型 用 在 许多 样本 的 因 变量 为 
零 或 特定 值 的 应 用 中 〈 如 汽车 文 出 、 医 疗 广 出 、 工 作 时 间 、 工 资 等 ) 。 该 模型 是 为 了 度量 受 限 的 因 变 量 ， 这 些 因 变 量 只 在 它 高 于 
或 低 于 某 个 截断 闻 值 时 才能 观察 到 。 例 如 : 


- 工资 最 低 额 被 最 低 工资 限制 ， 所 以 工资 额 不 会 低 于 最 低 工资 
: 捐献 给 问 关 机 构 的 捐赠 额度 

- 最 高 的 编程 收入 

` 个 人 的 可 用 时 间 和 休闲 活动 时 长 


间 松 回归 (Poisson regression) 处 理 因 变量 是 一 个 计数 总 和 的 情况 。 除 了 因 变 量 (Y) 是 一 个 符合 浊 松 分 布 的 计数 之 外 ， 
浊 松 回归 与 传统 的 多 项 式 回归 很 相似 。 因 此 ，Y 的 可 能 值 是 非 负 整数 : 0，1，2，3 等 。 一 般 来 况 ， 非 党 大 的 计数 是 很 少见 的 。 泪 
松 回归 与 逻辑 回归 相似 ， 因 为 逻辑 回归 也 是 有 一 个 离散 的 啊 应 变量 。 有 所 不 同 的 是 ， 油 松 回归 的 啊 应 不 像 逻 辑 回归 那样 局 限于 特 
殊 的 值 。 


22 判别 函数 分 析 : 地 下 苑 水 地 质 化 学 测量 


假设 有 一 项 对 从 矿井 收集 的 古代 工艺 品 的 研究 。 从 矿井 采集 宕 石 样品 并 对 及 集 的 宕 石 样品 进行 地 质 化 学 测量 。 一 个 相似 的 地 
质 化 学 测量 已 经 在 收集 来 的 古代 工艺 品 上 进行 过 。 为 了 将 宕 石 样本 进行 分 类 ， 归 类 到 它们 被 挖 据 出 来 的 矿井 ， 判 别 立 数 分 析 
(DFA) 可 以 作为 一 个 很 好 的 工具 。 然 后 ， 建 立 好 的 冰 数 束 可 以 用 于 判定 这 些 古 代 工 艺 品 来 源 于 哪个 矿井 。 


准备 工作 
为 了 应 用 判别 立 数 分 析 ， 我 们 需要 使 用 一 组 从 矿井 采集 的 数据 集合 。 
第 1 步 : 收集 和 摘 述 数据 


我 们 使 用 标题 为 BRINE 的 地 质 学 数据 分 析 数 据 集 。 该 数据 集 可 以 


从 http://www.kgs.ku.edu/Mathgeo/Books/Stat/ASCII/BRINE.TXT 获 取 。 其 中 的 数据 以 标准 格式 存储 ， 每 行 是 一 个 样本 ， 
列 是 一 类 变量 。 每 个 样本 被 指派 给 一 个 地 质 单元 并 列 在 最 后 一 列 。 该 数据 集 一 共 包 含 19 个 样本 和 8 个 变量 。 这 8 个 数值 型 变量 如 
F: 


: No 
. HCO3 


: SO4 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 


ARA PERIE : 


> library (MASS) 


版 本 信息 : 本 节 的 代码 在 R 3.2.3 中 测试 (2015-12-10) o 


让 我 们 探索 一 下 这 些 数 据 并 初步 理解 变量 之 间 的 关系 。 我 们 从 导入 名 为 brine.txt 的 文本 数据 开始 。 我 们 将 这 些 数 据 保存 到 
brine 数 据 框 中 ， 具 体操 作 如 下 : 


> brine <- read.table("d:/brine.txt", header-TRUE, sep=",", 
row.names-1) 


接 下 来 ， 输 出 brine 数 据 框 。head () BSZloEIBIbrineZI SERE. brineš ERFA SEA head () BEN. B 
体 命令 如 下 : 


> head (brine) 


结果 如 下 : 

HCO3 so4 Cl Ca Mg Na GROUP 
1 10.4 30.0 967.1 95.9 53.7 857.7 1 
2 6.2 29.6 1174.9 111.7 43.9 1054.7 1 
3 2.1 11.4. 2387.1 348.3 119.3 1932.4 1 
4 8.5 22.5 2186.1 339. 73.6 | 1803.4 1 
5 6.7 32.8 2015.5 287.6 75.1 1691.8 1 
6 3.8 18.9 2175.8 340.4 63.8 1793.9 1 


DFA 假 设 变量 符 合 多 元 正人 态 分 布 。 因 此 在 分 析 之 前 需要 验证 数据 是 否 符 合 多 元 正 仿 性 。 


为 了 验证 数据 集 是 否 适 合 进 行 转换 ， 我 们 首先 画 出 这 些 数 据 。pairs() 函数 用 来 画 出 数据 ， 该 滔 数 可 产生 一 个 离散 点 算 
阵 。 交 叉 作 图 法 只 交叉 比较 1~ 6 列 的 变量 。 最 后 一 个 变量 (第 7 列 ) 是 组 名 ， 所 以 不 列 入 比较 。 操 作 如 下 : 


> pairs(brine[ ,1:6]) 


画 出 的 图 表 如 下 面 的 截图 : 











0 40 80 0 200 500 500 2000 
o 
t o9 ^ ^ ` + ` ` οὐ ^ Ἴ 
ea h Co 8 η 轩 80 d oo 3 W *» ο 
e 
- i o - - 
S ο ος Ca p“ ο db 
o ΙΓ o o e io o " pum | Ë 
-g 
i a o e C4 
L| = tL al .. a" e 
Tooo o Go £b Ë ooo | ioo i N 
o 村 58mboo J μι οὐ) Lov? a ° mM ° ° Na 
(Ώ 
Ü 10 20 500 2000 0 100 200 


第 3 步 : 转换 数据 


明显 可 见 数 据 呈 现 蓝 星 状 分 布 。 这 表明 需要 对 数据 进行 log 变 换 ，log 变 换 对 地 质 化 学 数据 来 说 是 贡 见 的 变 损 方法 。 利 先 对 整 
个 数据 集 进行 复制 是 很 好 的 实践 经 验 ， 然 后 对 地 质 化 学 指标 进行 log 变 换 。 因 为 数据 中 包含 了 0， 所 以 我 们 对 这 份 数 据 集 及 用 
log+1 变 换 ， 而 不 是 log 变 换 。brine 数 据 框 复制 到 brine.log 数 据 框 。 对 该 数据 框 进行 log 变 换 。 代 码 如 下 : 


> brine.log «- brine 
> brine.log[ ,1:6] <- log(brine[ ,1:6]+1) 
> pairs(brine.log[ ,1:6]) 


在 对 数据 进行 变换 之 后 ， 为 了 重新 评估 多 元 正人 态 性 。 使 用 pairs() 函数 重新 绘 出 brine.log。 现 在 的 分 布 看 上 去 更 加 正 态 。 
相 比 之 前 的 图 偏 科 减少 了 。 


> pairs(brine.log[ ,1:6]) 


画 出 的 图 表 如 下 面 的 截图 : 
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第 4 步 : 训练 模型 


N 
4 





这 一 步 是 通过 判别 函数 分 析 训练 模型 。 调 用 lda () ERENEGUSUESASU TTAU F: 


> brine.log.lda <- lda (GROUP ~ HCO3 + SO4 + Cl + Ca + Mg + Na, 
data=brine.log) 
调用 的 形式 很 像 线性 回归 或 ANOVA， 痢 需要 传 入 一 个 定义 好 的 方程 。 该 问题 中 ，GROUP 变 量 当 作 因 变 量 ， 地 质 化 学 指标 
当 作 目 变量 。 这 次 试验 中 ， 变 量 间 没有 交叉 ， 所 以 变量 用 + 操作 加 起 来 而 不 是 * 操作 。 因 为 没有 调用 attach () 消 数 ， 所 以 数据 
框 的 名 字 也 必须 传 入 。 在 运行 DFA 之 后 ， 通 过 如 下 命令 查看 结果 : 


> brine.log.l1da 


结果 如 下 所 示 : 


Call: 
lda(GROUP ~ HCO3 + SO4 + Cl + Ca + Mg + Na, data = brine.log) 
Prior probabilities of groups: 


1 2 3 
0.3684211 0.3157895 0,3157895 
Group means: 
HCO3 804 Cl Ca Mg Na 


1 1.759502 3.129009 7.496891 5.500942 4.283490 7.320686 
2 2.736481 3.815399 6.829565 4.302573 4.007725 6.765017 
3 1.374438 2.378965 6.510211 4.641049 3.923851 6.289692 
Coefficients of linear discriminants: 


LD1 LD2 
HCO3 -1.67799521 0.64415802 
904 0.07983656 0.02903096 
Cl 22.27520614 -0 .31427770 
Ca -ᾱ. 26559568 2. 94458682 
Μα —1.858732009 -2.89413332 
Na -20.86566883 1.29368129 
Proportion of trace: 
LD1 LD2 
0.7435 0.2565 


- 输出 结果 的 第 1 部 分 显示 拟 合 的 公式 。 


第 2 部 分 是 各 组 的 先 验 概 率 ， 它 反映 了 数据 集 内 各 组 的 占 比 。 换 匈 话 说， 如果 你 没有 度量 变量 ， 并 且 实 验 中 各 组 的 样本 数 


量 代表 了 实际 各 组 的 相对 丰富 程度 ， 那 么 这 个 先 验 概率 将 可 描述 任何 未 知 样本 属于 各 组 的 概率 。 


: 第 3 部 分 用 各 组 各 变量 平均 值 表 的 形式 显示 了 各 组 的 均值 。 扫 描 此 表 可 以 帮助 你 发 现 菜 组 是 否 在 一 个 或 多 个 变量 中 具有 特 


` 最 后 ， 第 5 部 分 显示 了 迹 (trace) 的 比例 ， 该 比例 给 出 了 每 个 判别 函数 的 方差 解释 。 在 这 里 ， 第 一 个 判别 解释 了 将 近 75% 


的 方差 其余 的 由 第 二 个 判别 解释 。 
第 5 步 : 分 类 数据 


predict () 尔 数 也 是 MASS 包 中 的 一 部 分 ， 该 立 数 使 用 lda () 的 结果 将 样本 分 配给 各 组 。 换 名 话说 ，lda () 得 到 了 一 个 能 
够 分 组 的 线性 函数 ，predict () 可 以 在 相同 的 数据 中 应 用 该 函数 ， 用 来 检验 分 类 浮 数 的 分 类 能 力 有 多 强 。 按 照 统计 学 惯例 ，x- 
hat 是 x 的 预测 (hat 加 到 对 象 名 字 上 ， 以 明确 它们 是 预测 ) 。 代 码 如 下 : 


> brine.log.hat <- predict (brine.log.lda) 


输出 brine.log.hat 如 下 : 


> brine.log.hat 


结果 如 下 : 


$class 
[1] 2 L l11 11 14 22 2 2 2 3 3 3 3 3 3 
Levels: 12 3 


$posterior 
1 2 3 
1 2.312733e-01 7.627845e-01 5.942270e-03 
2 9.488842e-01 3.257237e-02 1.854347e-02 
3 8.453057e-01 9.482540e-04 1.537461e-01 
4 9.990242e-01 8.794725e-04 9.632578e-05 
5 9.965920e-01 2.849903e-03 5.581176e-04 
6 9.984987e-01 1.845534e-05 1.482872e-03 
7 8.676660e-01 7.666611e-06 1.323263e-01 
8 4.938019e-03 9.949035e-01 1.584755e-04 
9 4.356152e-03 9.956351e-01 8.770078e-06 
10 2.545287e-05 9.999439e-01 3.066264e-05 
11 2.081510e-02 9.791728e-01 1.210748e-05 
12 1.097540e-03 9.989023e-01 1.455693e-07 
13 1.440307e-02 9.854613e-01 1.356671e-04 
14 4.359641e-01 2.367602e-03 5.616683e-01 
15 6.169265e-02 1.540353e-04 9.381533e-01 
16 7.500357e-04 4.706701e-09 9.992500e-01 
17 1.430433e-03 1.095281e-06 9.985685e-01 
18 2.549733e-04 3.225658e-07 9.997447e-01 
19 6.433759e-02 8.576694e-03 9.270857e-01 
$x 
LD1 LD2 

1 -1.1576284 —0.1998499 
2 -0.1846803 0.6655823 
3 1.0179998 0.6827867 
4 -0. 3939366 2.6798084 
5 -0. 3167164 2.0188002 
6 1.0061340 2.6434491 
yi 2.0725443 1.5714400 
8 -2.0387449 -0.9731745 
9 -2. 6054261 -0.2774844 
10 -2.5191350 -2.8304663 
11 -2.4915044 0.3194247 
12 —3.4448401 0.1869864 

13 -2.0343204 —0.4674925 

14 1.0441237 —0.0991014 

15 1.6987023 -0. 6036252 

16 3.9138884 -0.7211078 

17 2.7083649 -1.3896956 

18 2.9310268 -1.9243611 

19 0.7941483 -1.2819190 


上 面 的 输出 以 每 个 样本 被 指定 的 分 类 开始 。 接 下 来 列 出 了 每 个 样本 属于 每 个 分 组 的 后 验 概率 ， 每 一 行 ( 即 每 个 样本 ) 的 概率 
之 和 为 1.0。 这 些 后 验 概率 衡量 了 样本 属于 每 个 分 类 的 强度 。 如 果 一 个 样本 属于 某 个 组 的 概率 比 其 他 概率 高 出 很 多 ， 那 么 该 样本 
属于 这 个 组 的 可 能 性 束 很 高 。 如 果 两 个 或 多 个 概率 接近 ， 那 么 样本 的 分 组 束 比 较 不 确定 。 


接 下 来 的 命令 可 以 在 有 多 个 分 组 的 情况 下 以 一 个 快捷 的 方式 找到 每 个 样本 的 最 大 概率 : 


> apply(brine.log.hat$posterior, MARGIN-1, FUN-max) 

1 2 3 4 5 6 
7 8 
0.7627845 0.9488842 0.8453057 0.9990242 0.9965920 0.9984987 0.8676660 
0.9949035 

9 10 11 12 13 14 
15 16 
0.9956351 0.9999439 0.9791728 0.9989023 0.9854613 0.5616683 0.9381533 
0.9992500 

17 18 19 

0.9985685 0.9997447 0.9270857 


因为 数据 集中 大 多 数 概率 值 是 较 大 的 (>0.9) ， 这 表明 大 多 数 样本 已 经 家 成 功 分 配给 一 个 组 。 


如 果 大 多 数 概率 是 大 的 ， 整 体 的 分 类 融 是 成 功 的 。predict () RESER EST REASXSIT GT 7 SUE ΗΡΙ 


数 。 束 像 主 成 分 分 析 中 的 分 数 也 可 以 被 画 出 一 样 ， 这 些 分 数 被 男 出 以 展现 分 组 在 判别 浮 数 中 是 如 何 分布 的 。 代 码 如 下 : 


> plot (brine.1og.1da) 


这 三 组 占据 了 完全 不 同 并 且 不 重 赦 的 区 域 。 只 有 一 个 1 组 的 样本 靠近 2 组 ， 所 以 我 们 可 以 明确 地 说 这 个 判别 是 成 功 的 。 


画 出 的 图 表 如 下 : 
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> plot(brine.log.lda, dimen=1, type="both") 
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同样 ， 判 别 函 数 1 上 有 着 良好 的 组 分 割 ， 特 别 是 2 组 更 加 明显 。 
第 6 步 : 评估 模型 


DFA 的 分 类 效率 需要 被 评估 ， 可 以 通过 比较 predict () 的 分 类 结果 和 真实 分 组 来 进行 评 佑 。table () 函数 是 一 个 很 有 用 的 


用 于 评估 的 函数 。 按 照 约定 ， 调 用 该 函数 时 ， 需 将 实际 分 组 当 作 第 一 个 参数 ， 预 测 的 分 组 当 作 第 二 个 参数 ， 代 码 如 下 : 


> tab <- table(brine.log$GROUP, brine.log.hat$class) 


输出 tab 的 值 : 
> 七 ab 
结果 如 下 : 
i 2 3 
T x 5 Ø 
2. dj & Ὁ 
a du Ὁ. wd 


输出 的 每 一 行 对 应 每 个 分 组 的 原始 数据 ， 每 一 列 对 应 于 DFA 做 出 的 分 组 。 在 一 个 完美 的 分 类 中 ， 大 的 数值 会 沙 人 在 对 角 绪 上 ， 
对 角 线 外 的 值 应 该 是 0， 这 就 表明 所 有 属于 1 组 的 样本 被 DFA 判 别 为 属于 1 组 ， 其 他 组 类 似 。 访 表 的 形式 能 够 让 你 很 好 地 洞察 哪些 
分 组 被 可 信 的 判别 了 。 它 也 能 表明 哪些 分 组 可 能 是 混乱 的 以 及 哪 种 错 分 类 比 其 他 常见 。 


下 面 的 命令 可 以 计算 整体 预测 准确 度 ， 即 落 在 对 角 线 上 的 样本 比例 : 
> sum(tab[row(tab) == col(tab)]) / sum(tab) 


结果 如 下 : 


[1] 0.9473684 


iX EBRS TRU EERREPSEEEUT9576, FERR. ADAE f PIBBURM ΛΙ, BÜZABTESEEANSIAS FHSETAEETURUBSSXERUT S76 


确 率 . 


第 二 个 衡量 DFA 的 手段 是 留 一 交叉 验证 法 (也 叫 对 折 验 证 法 ) ， 这 种 验证 法 在 训练 时 排除 一 个 样本 。 使 用 排除 一 个 样本 后 余 
下 的 n-1 个 样本 进行 DFA 训 | 练 。 交 又 验 证 技术 自动 地 应 用 在 数据 集中 的 每 一 个 样本 上 。 为 了 完成 这 个 验证 ， 需 添加 
CV=TRUE ( 即 交 叉 验证 ) 到 lda () 调用 中 ， 代 码 如 下 : 


> brine.log.lda «- lda(GROUP ~ HCO3 + SO4 + Cl + Ca + Mg + Na, 
data-brine.log, CV=TRUE) 
分 组 判别 的 准确 性 能 够 被 上 文 类 似 的 方法 衡量 ， 代 码 如 下 : 
> tab <- table(brine.log$GROUP, brine.log.lda$class) 


打 Eptab 的 值 如 下 : 


> 七 ab 


结果 如 下 : 


1 2 3 

1 6 1 0 

2 1 4 1 

3 1 0 5 
> sum(tab[row(tab) == col(tab)]) / sum(tab) 


结果 如 下 : 


[1] 0.7894737 


该 数据 集中 ， 对 折 验 证 准确 率 较 低 (准确 率 只 有 79%) ， 这 反映 了 再 代入 误差 往往 造成 对 DFA 性 能 的 高 估 。 这 样 的 问题 在 类 
似 这 样 的 小 数据 集中 非常 党 罗 ， 而 判别 尔 数 分 析 往 往 在 大 数据 集中 更 加 成 功 。 


23 ”多 元 逻辑 回归 : 理解 学 生 的 谍 程 计划 选择 


让 我 们 假设 高 中 学 生 在 进行 课程 计划 选择 。 学 生 们 拥有 选择 课程 计划 的 机 会 ， 课 程 计 划 有 三 种 ,分 别 是 通用 课程 、 职 业 课 程 
和 学 术 课 程 。 每 个 学 生 的 选择 是 基于 自己 的 写作 分 数 和 社会 经 济 情况 。 


准备 工作 


为 了 完成 这 个 任务 ， 我 们 需要 使 用 学 生 的 数据 集 。 第 1 步 是 收集 数据 。 
第 1 步 : 收集 数据 


该 任务 使 用 名 为 hsbdemo 的 学 生 数 据 集 。 该 数据 集 可 从 http://voia.yolasite.com/resources/hsbdemo.csv 下 载 ， 格 式 为 
MS Excel。 其 中 包含 201 个 数据 行 和 13 个 变量 。8 个 数值 型 变量 如 下 : 


= wtite 

: math 

”Sclence 

* sOcst 

` awards 

: cid 

非 数 值 型 变量 如 下 : 


: gender 


` schtyp 


' prog 


: honors 


具体 实施 步骤 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 


第 1 步 是 载 入 类 库 。 如 果 类 库 不 仔 任 ，library () 消 数 将 返回 错误 。 使 用 的 命令 如 下 : 


library(foreign) 
library (nnet) 
library (ggplot2) 
library (reshape2) 


版 本 信息 : 本 节 的 代码 在 R 3.2.3 版 本 中 测试 (2015-12-10) ο 


探索 数据 的 过 程 可 以 友 现 这 些 数 据 之 间 天 系 的 一 些 有 葵 的 结论 。 名 为 hsbdemo.csv 的 CSV 文 件 需要 被 载 入 到 R 环 境 。 被 导入 
的 数据 保存 在 以 ml 为 标题 的 数据 框 中 ， 代 码 如 下 : 


> ml <- read.table("d:/hsbdemo.csv", header-TRUE, sep=",", 
row.names="id") 


我 们 可 以 使 用 with () 函数 来 查 探 感 兴 趣 变 量 的 摘 述 性 统计 信息 ， 代 码 如 下 : 


> with(ml, table(ses, prog)) 


结果 如 下 : 
prog 
ses cademic general vocation 
high 42 9 7 
low 19 16 12 
middle 44 20 31 


我 们 可 以 通过 如 下 代码 获取 均值 和 标准 差 : 


> with(ml, do.call(rbind, tapply (write, prog, function(x) c(M = 
mean(x), SD - sd(x))))) 


结果 如 下 : 
M SD 
academic 56.25714 7.943343 
general 51.333333 9.397715 
vocation 46.76000 9.318754 


通过 上 面 的 结果 可 以 友 现 ， 学 术 课 程 的 均值 最 高 ， 通 用 课程 的 标准 差 最 高 。 


第 3 步 : 训练 模型 


使 用 multinom () 函数 估计 多 元 逻辑 回归 。multinom () 函数 不 需要 对 数据 进行 变形 。 


选择 结果 的 对 照 组 很 重要 。 我 们 可 以 通过 rellevel () 水 数 选择 我 们 期 望 作为 基准 的 结果 水 平 。 然 后 ,使 用 multinom () B5 
数 运 行 模 型 。 因 为 没有 为 回归 系数 进行 p 值 计算 ， 这 里 使 用 Wald 检 验 (z 检 验 ) 进行 p 值 检验 。 传 入 multinom () 的 公式 具有 响 
应 一 预测 器 的 形式 。 数 据 框 ml 是 公式 中 出 现 的 变量 的 解释 ， 代 码 如 下 : 


> ml$prog2 «- relevel(ml$prog, ref = "academic") 
> test <- multinom(prog2 ~ ses + write, data = ml) 


结果 如 下 : 
# weights: 15 (8 variable) 
initial value 219.722458 
iter 10 value 179.983731 
final value 179.981726 
converged 
> summary (test) 
结果 如 下 : 
CALL: 
multinom(formula = prog2 ~ ses + write, data = ml) 
Coefficients: 
(Intercept) seslow sesmiddle write 
general 1.689478 1.1628411 0.6295638 —0.05793086 
vocation 4.235574 0.9827182 1.2740985 -0.11360389 


Std. Errors: 


(Intercept) seslow sesmiddle write 
general 1.226939 0.5142211 0.4650289 0.02141101 
vocation 1.204690 0.5955688 0.5111119 0.02222000 


Residual Deviance: 359.9635 
AIC: 375.9635 


接 下 来 ， 系 数 检 验 摘要 除 以 标准 误差 检验 摘要 ， 如 下 : 


> z <- summary(test)$coefficients/summary (test)S$standard.errors 


显示 z 的 值 如 下 : 
> z 
结果 如 下 : 
(Intercept) seslow sesmiddle write 
general 1.376987 2.261364 1.353816 -2.705658 
vocation 3.515904 1.650050 2.492798 -5.112687 


第 4 步 : 测试 模型 结果 
用 如 下 代码 进行 双 尾 z 检 验 : 


» p «- (1 - pnorm(abs(z), O, 1))*2 


展示 p 值 如 下 : 


结果 如 下 : 
(Intercept) seslow sesmiddle write 
general 0.1685163893 0.02373673 0.1757949 6.816914e-03 
vocation 0.0004382601 0.09893276 0.0126741 3.176088e-07 


相对 风险 率 的 定义 是 指定 结果 类 别 和 基准 类 别 的 概率 的 比值 。 相 对 风险 率 是 线性 方程 右边 部 分 的 指数 。 指 数 回归 系数 是 预测 
变量 中 一 个 单元 变化 的 相对 风险 比率 。 


从 模型 中 提取 出 模型 系数 ， 然 后 计算 系数 的 指数 如 下 : 


> exp(coef (test)) 


结果 如 下 : 
(Intercept) seslow sesmiddle write 
general 5.416653 3.199009 1.876792 ϱ. 9437152 
vocation 69.101326 2.071709 3575477 ϱ. 8926115 


变量 write 的 通用 课程 对 比 学 术 课 程 的 相对 风险 比率 单元 增长 是 0.9437。 通 用 课程 对 比 学 术 课 程 的 相对 风险 比率 转换 从 
ses=1 到 3 是 0.3126。 使 用 已 经 被 预测 的 概率 来 得 到 一 个 模型 的 洞察 。fitted O 函数 用 来 计算 每 个 结果 水 平 下 的 预测 概率 : 


> head (PP <- fitted(test)) 


结果 如 下 : 

academic general vocation 
45 .1482721 0 .3382509 0.5134769 
108 0.1201988 0.1806335 0.6991678 
15 0.4186768 0.2368137 0.3445095 
67 0.1726839 0.3508433 0.4764728 
153 0.1001206 0.1689428 0.7309367 
51 035233593 0.2378047 0.4088370 


检查 与 ses 和 write 两 个 变量 之 一 相 联系 的 概率 的 变化 。 在 保持 一 个 变量 不 变 的 同时 ， 创 建 一 个 在 另 一 个 变量 上 变化 的 小 数 
据 。 首 先 ， 保 持 write 变量 为 它 的 均值 ， 然 后 检查 每 个 ses 变 量 水 平 的 预测 概率 如 下 : 
> dses «- data.frame(ses = c("low", "middle", "high"),write = 


mean (ml$write)) 
» predict(test, newdata - dses, "probs") 


结果 如 下 : 


academic general vocation 
1 0.4396813 0,3581915 0.2021272 
2 0.4777451 0. «285359 0.2939190 
3 0.7009046 0.1784928 0.1206026 


看 看 对 于 拥有 连续 预测 值 的 变量 的 不 同 值 的 平均 预测 概率 ， 用 预测 概率 如 下 : 


> dwrite <- data.frame(ses = rep(c("low", "middle", "high"), each = 
41), write - rep(c(30:70), 3)) 
存储 每 个 ses 和 write 值 的 预测 概率 如 下 : 
> pp.write «- cbind(dwrite, predict(test, newdata = dwrite, type = 


"probs", se - TRUE)) 


计算 每 个 ses 等 级 内 的 平均 概率 如 下 ; 


> by(pp.write[, 3:5], pp.write$ses, colMeans) 


结果 如 下 : 
pp.write$ses: high 
academic general vocation 
0.6164348 0.1808049 0.2027603 
pp.write$ses: low 
academic general vocation 
0.3972955 0.3278180 0.2748864 
pp.write$ses: middle 
academic general vocation 
0.4256172 0.2010877 0.3732951 


有 了 时， 一 对 图 像 的 对 比 能 够 更 好 地 传递 信息 。 使 用 先前 为 pp.write 对 象 生成 的 预测 ， 我 们 能 够 画 出 不 同 ses 等 级 下 writing 分 
数 的 预测 概率 变化 。melt () 遂 数 能 够 把 数据 转换 成 以 宽 表 的 格式 表示 ， 并 将 一 组 列 栈 压 进 单 独 的 数据 列 中 。lpp 数 据 框 用 来 存 
储 转换 后 的 数据 框 如 下 : 


> lpp «- melt(pp.write, id.vars = c("ses", "write"), value.name = 
"probability") 
输出 数 信 的 头 几 行 如 下 : 
> head (lpp) 
结果 如 下 : 
ses write variable probability 
1 low 30 academic 0.09843258 
2 low 31 academic 0.10716517 
3 low 32 academic 0.11650018 
4 low 33 academic 0.12645441 
9 low 34 academic 0.13704163 
6 low 35 academic 0.14827211 
下 面 画 出 预测 概率 在 write 数值 对 于 每 个 ses 等 级 以 课程 类 型 分 片 的 图 表 : 
> ggplot(lpp, aes(x = write, y = probability, colour = ses)) 十 


十 geom line() + 


十 facet grid(variable ~ ., scales-"free") 
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24 Tobit[n]]H: 评估 学 生 的 学 术 能 


让 我 们 通过 打分 来 评估 一 个 学 生 的 学 术 能 力 ， 分 数 范围 是 200 ~ 800 分 。 该 评估 基于 使 用 阅读 和 数学 分 数 的 模型 。 学 生 参 与 
的 课程 计划 的 类 型 特点 也 被 考虑 进去 。 有 三 种 课程 计划 类 型 : 学 术 型 、 通 用 型 和 职业 型 。 这 种 打分 的 评分 方式 仔 企 一 个 问题 ， 残 
是 一 些 学 生 可 能 回答 对 了 所 有 的 学 术 能 力 测试 问题 并 得 到 800 分 ， 但 这 些 学 生 可 能 在 学 术 能 力 上 并 不 真正 相同 。 同 样 的 情况 也 会 
上 友 生 在 那 尝 全 部 答 错 所 有 问题 并 且 得 到 200 分 的 学 生 上 。 


准备 工作 
为 了 完成 这 个 实验 ， 我 们 需要 用 到 学 生 的 数据 集 。 第 1 步 是 收集 数据 。 


第 1 步 : 收集 数据 


为 建立 Tobit 回 归 模型 ， 需 要 使 用 名 为 tobit 的 学 生 数 据 集 ， 设 数据 集 可 从 http://www.ats.ucla.edu/stat/data/tobit.csv 下 
载 ， 格 式 为 MS Excel。 其 中 包含 201 行 数据 和 5 个 变量 。4 个 数值 型 变量 如 下 : 


- apt 


非 数 值 型 变量 如 下 : 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 


第 1 步 是 载 入 如 下 库 。require () 函数 被 设 计 用 来 在 其 他 函数 的 内 部 使 用 ;如 果 包 不 仔 企 ， 它 返回 FALSE 并 给 出 警告 (而 不 
是 像 library () ENARE nR) 。 所 用 的 代码 如 下 : 


> require (ggplot2) 
> require (GGally) 
> require (VGAM) 


版 本 信息 : 本 节 的 代码 在 R 3.2.3 版 本 中 测试 (2015-12-10) ο 


下 面 我 们 开始 探索 数据 并 理解 不 同 变量 间 的 关系 。 我 们 从 导入 名 为 gala.txt 的 CSV 数 据 文 件 开始 ， 将 数据 保存 到 dat 数 据 框 
中 ， 代 码 如 下 : 


> dat <- read.table("d:/tobit.csv", header-TRUE, sep=",", 
row.names-"id") 


在 该 数据 集中 ，apt 的 最 低 值 是 32?2。 这 表明 没有 学 生得 到 最 低 分 数 200。 即 使 下 界 删 减 是 可 能 的 ， 也 不 需要 在 本 数据 集中 考 
RAR. EAU FINS: 


> summary (dat) 


结果 如 下 : 


Id read math prog apt 
Min. S£ 1.0 Min . :28 .0 Min . 133.9 academic : 45 Min. 1354 
lst Ou.: 50.8 1st Qu.:44.0 15: Qu.:45.0 general :105 1st Qu.:576 
Median :100.5 Median :50.0 Median :52.0 vocational: 50 Median :633 


Mean 200.5 Mean 52 2 Mean κ. ο Mean : 640 
srd Qn.:150.2 3rd Qu.:60.0 ara Qu. 59.0 srd Ou.:705 
Max. :200.0 Max. :76.0 Max. -A Max. : 800 


第 3 步 : 绘制 数据 


write 是 一 个 函数 ， 它 给 出 了 给 定 均值 和 方差 的 正 态 分 布 的 概率 密度 ， 设 概率 密度 已 经 被 拉 伸 到 总 数 度 量 。 我 们 使 用 如 下 代 
码 生 成 以 density*sample size*bin width 为 高 度 的 柱状 图 : 


> f <- function(x, var, bw = 15) { 
dnorm(x, mean - mean(var), sd(var)) * length(var) * bw 
) 


设置 基准 线 如 下 : 


> p «- ggplot(dat, aes(x = apt, fill-prog)) 
SUCEESSTATBUEETAES, LATISIBRES AZAR ISIAREELTAUBIREG, [IBJAGUIERÓS BEBE EE EÜEZXSES, (VIBRI F: 


> p + stat bin(binwidth-15) + 
stat function(fun = f, size = 1, 
args = list(var = dat$apt)) 


柱状 图 如 下 : 
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观察 上 面 的 柱状 图 ， 我 们 能 够 发 现 apt 明 显 被 截断 了 ， 在 750 ~ 800 的 分 段 上 ， 相 比分 布 的 其 余部 分 ， 样 本 数量 比 期 望 数 量 多 


在 下 面 的 另 一 种 形式 的 柱状 图 中 ，apt = 800 的 样本 数量 被 着 重 标 出 。 在 下 面 的 柱状 图 中 ， 通 过 设置 breaks 选 项 使 每 一 个 apt 


独立 值 都 有 目 己 的 柱子 (设置 breaks 等 于 创建 了 一 个 包含 从 最 小 的 apt 到 最 大 值 apt 的 和 天 量 ) 。 虽 然 接 近 分 布 中 央 的 位 置 ， 一些 
apt 值 有 两 到 三 个 样本 ,但 因为 apt 值 是 连续 的 ， 所 以 数据 集中 大 多 数 apt 值 只 有 了 唯一 的 样本 。 


柱状 图 最 右边 的 尖峰 是 apt = 800 时 的 样本 柱子 ， 相 对 于 其 他 柱子 来 说 ， 这 个 柱子 的 高 度 清 晰 地 显示 了 该 值 的 样本 数 大 大 超 


出 常规 的 数量 。 用 如 下 命令 生成 该 图 : 


> p+ stat bin(binwidth = 1) + stat function(fun = f, size = 1, args = 
list(var - dat$apt, 
bw - 1)) 
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第 4 步 : 探索 数据 间 天 系 
下 面 的 命令 用 来 探索 数据 集中 的 二 元 关系 : 


> Cor (dat [, σ ( "read" ; "math" , "apt tt.) ] ) 


结果 如 下 : 
read math apt 
read 1.0000000 0.6622801 0.6451215 
math 0.6622801 1.0000000 0.7332702 
apt 0.6451215 0.7332702 1.0000000 
IB] HA RS AR ERT F : 


» ggpairs(dat[, c("read", "math", "apt")]) 
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在 散 点 图 矩阵 的 第 一 行 中 ， 散 点 图 显示 了 read 和 apt 的 关系 。math 和 apt 的 关系 也 被 建立 并 展现 出 来 。 


第 5 步 : 训练 模型 


使 用 VGAM 包 中 的 vglm 冰 数 运 行 Tobit 模 型 ， 命 令 如 下 : 
> summary(m «- vglm(apt ~ read + math + prog, tobit(Upper = 800), data 
= dat)) 
结果 如 下 : 
Call: 
vglm (formula = apt ~ read + math + prog, family = tobit(Upper = 800), 
data - dat) 
Pearson residuals: 
Min 1ο Median 3Q Max 
mu -2.5684 -0.7311 -0.03976 0.7531 2.802 
loge (sd) -0.9689 -0.6359 -0.33365 0.2364 4.845 
Coefficients: 
Estimate Std. Error z value Pr (>|z|) 

(Intercept) :1 209.55956 32.54590 6.439 1.20e-10 *** 
(Intercept):2 4.18476 0.05235 79.944 « 2e-16 *** 
read 2.69796 0.61928 4.357 1.32e-05 *** 
math 5.91460 0.70539 8.385 < 2e-16 *** 
proggeneral -12.71458 12.40857 -1.025 0.305523 
progvocational —46.14327 13.70667 -3.366 0.000761 *** 
Signif. codes: 0 '***' 0,001 '**' 0.01 1%! 0.05 *.* 0.1 * t 1 
Number of linear predictors: 2 

Names of linear predictors: mu, loge(sd) 

Dispersion Parameter for tobit family: 1 


Log-likelihood: -1041.063 on 394 degrees 
Number of iterations: 5 


前 面部 分 的 输出 告诉 我 们 选项 设置 。 


of freedom 


以 coefficients 为 标签 的 表 给 出 了 标准 误差 和 和 z 统 计 的 系数 。 摘 要 表 中 不 包含 p 值 。 


Tobit 回 归 系 数 的 解释 与 OLS 回 归 系 数 的 解释 相似 。 线 性 系数 影响 指 的 是 在 删 减 隐藏 变量 上 的 影响 : 
.ftead 分 数 增加 1 个 单位 ，apt 预 测 值 增加 2.6980 分 。 
* math 分 数 增加 1 个 单位 ，apt 预 测 值 增加 5.9146 个 单位 。 


: prog 的 相关 项 有 一 个 稍微 不 同 的 解释 。 选 择 职业 课程 计划 的 学 生 的 apt 预 测 值 是 -46.1419， 即 相 比 选择 学 术 课 程 计 划 的 学 生 
低 。 


- 标签 为 (Intercept) : 1 的 系数 是 模型 的 截断 或 常数 。 


- 标签 为 (Intercept) : 2 的 系数 是 一 个 附属 统计 量 。 该 值 的 指数 类 似 于 OLS 回 归 残 余 方差 的 平方 根 。65.6773 的 值 相 比 学 术 


能 力 的 标准 差 99.21， 是 一 个 比较 大 的 降低 。 
输出 的 最 下 面 显 示 了 最 终 的 对 数 相 似 度 -1041.0629， 该 值 可 用 来 做 模型 的 交叉 对 比 。 
第 6 步 : 测试 模型 


使 用 z 值 计算 模型 中 每 个 系数 的 p 值 。 然 后 以 局 平 表 的 形式 显示 这 些 值 。read、math、 和 prog = 3 (职业 课程 计划 ) 的 系数 
统计 上 非常 显著 ,命令 如 下 : 


> ctable «- coef (summary (m)) 

> pvals «- 2 * pt(abs(ctable[, "z value"]), df.residual(m), lower.tail 
= FALSE) 

> cbind(ctable, pvals) 


结果 如 下 : 


Estimate Std. Error z value Pr(»|z|) pvals 
(Intercept):1 209.559557 32.54589921 6.438893 1.203481e-10 
3.505839e-10 


(Intercept) :2 4.184759 0.05234618 79.943922 | 0.000000e400 
1.299833e-245 
read 2.697959 0.61927743 4.356625 1.320835e-05 
1.686815e-05 
math 5.914596 0.70538721 8.384892 . 5.077232e-17 
9.122434e-16 
proggeneral -12.714581  12.40856959 -1.024661 3.0552306-01 


3.061517e-01 
progvocational —46.143271 13.70667208 -3.366482 7.613343e-04 
8.361912e-04 


我 们 使 用 去 除 课程 计划 类 型 标 等 的 数据 整体 上 适 配 一 个 模型 ， 然 后 使 用 似 然 比 来 检验 课程 计划 类 型 的 显著 性 ， 代 码 如 下 : 


> m2 «- vglm(apt ~ read + math, tobit (Upper = 800), data = dat) 
> (p <- pchisq(2 * (logLik(m) - logLik(m2)), df = 2, lower.tail = 
FALSE)) 


结果 如 下 : 


[1] 0.003155176 


prog 变 量 的 p 值 等 于 0.0032， 该 值 表示 了 prog 变 量 的 统计 显著 性 。 我 们 计算 该 系数 的 上 限 和 下 限 分 别 为 95% 的 置信 区 间 : 


> b «- coef (m) 
> se <- sqrt (diag(vcov (m))) 
» cbind(LL 5 b - qnorm(0.975) * 


结果 如 下 : 

工 工 
(Intercept):1 145.770767 
(Intercept) :2 4.082163 
read 1.484198 
math 4.532062 
proggeneral -37.034931 
progvocational -73.007854 


se, 


UL = b + qnorm(0.975) * se) 


UL 
348348 


.287356 
49411721 
29171129 
.605768 
.278687 


ΙΒ ΠΕ T EFI EHE, RATAA EE EREIBEN (Pearson) 值 以 及 正 态 性 和 同 质变 量 的 假 


有 利于 我 们 检查 模型 和 数据 匹配 情况 ， 代 码 如 下 : 


> dat$yhat «- fitted(m)[,1] 
dat$rr «- resid(m, type 


y 


> par(mfcol = c(2, 3)) 


» with(dat, { 


= "response") 
> dat$rp «- resid(m, type = "pearson")[,1] 


plot(yhat, rr, main - "Fitted vs Residuals") 

qqnorm (rr) 

plot (yhat, rp, main = "Fitted vs Pearson Residuals") 
qqnorm (rp) 

plot (apt, rp, main = "Actual vs Pearson Residuals") 
plot(apt, yhat, main - "Actual vs Fitted") 


}) 


画 出 的 图 表 如 以 下 截图 所 示 : 
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建立 相关 性 如 下 : 


> (r <- with(dat, cor(yhat, apt))) 


结果 如 下 : 
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[11 0.7825 


方差 计算 如 下 : 
= Ἐν 


结果 如 下 : 


[1] 0.6123 


apt 预 测 值 和 实际 观测 值 的 相关 性 是 0.7825。 如 果 计算 该 值 的 平方 ， 可 以 得 到 平方 相关 系数 ， 这 表示 预测 值 与 apt 变 量 分 享 
了 61.23% 的 方差 。 


25 泪 松 回归 : 理解 加 拉 由 区 斯 群 咏 现 仔 物种 


加 拉 帕 太 斯 群岛 坐落 在 距离 厄瓜多尔 海岸 大 约 1000 公 里 远 的 太平 洋 上 。 该 群岛 由 13 个 岛 屿 组 成 ， 其 中 5 个 有 人 居住 。 访 群岛 
的 动 植物 种 类 十 分 丰富 。 科 学 家 人 至今 仍 非常 困惑 为 什么 如 此 小 且 遥 远 的 群岛 能 够 具有 如 此 繁盛 多 样 的 物种 群 。 


准备 工作 


为 了 完成 这 个 实验 ， 我们 需要 利用 物种 数据 集 。 第 1 步 是 收集 数据 。 
第 1 步 : 收集 和 摘 述 数据 


我 们 利用 名 为 gala 的 物种 数量 数据 集 ， 该 数据 集 可 
从 https://github.com/burakbayramli/kod/blob/master/books/Practical Regression Anove Using R Faraway/gala.txt F 
载 。 其 中 包含 30 个 样本 和 7 个 变量 。 这 7 个 数值 型 的 变量 包括 : 


` Species 

: Endemics 
: Area 

: Elevation 
: Nearest 

` Scruz 


: Adjcacent 


以 下 为 实现 细节 。 


第 2 步 : 探索 数据 


探索 数据 将 会 帮助 我 们 友 现 一 些 数 据 间 天 系 的 绪 系 。 我 们 从 导入 名 为 gala.txt 的 文本 数据 文件 开始 。 将 数据 保 仔 到 gala 数 据 
框 中 ， 命 令 如 下 : 


> gala «- read.table("d:/gala.txt") 
regpois () 函数 给 出 了 生态 学 角度 非 单 重要 的 几 个 变量 的 油 松 回 归 ， 命 令 如 下 : 


> regpois «- glm( Species ~ Area + Elevation + Nearest, family-poisson, 
data-gala) 


下 面 给 出 数据 的 摘要 : 


> summary (regpois) 


summary kšn, XXX. signifa. SmE. Sm. AICTUZRISA MENACE. ARAUT : 


Deviance residuals: 


Min 19 Median 30 Max 
-17.1900 -6.1715 -2.7125 0.7063 21.4237 
Coefficients: 
Estimate Std. Error z value Pr (>|z|) 
(Intercept) 3.548e+00 3.933e-02 90.211 < 2e-16 *** 
Area —5.529e-05 1.890e-05 -2.925 0.00344 ** 
Elevation 1.588e-03 5.040e-05 31.502 < 2e-16 大 大 大 
Nearest 5.921e-03 1.466e-03 4.039 5.38e-05 *** 


Signif. codes: 
0 '***'"' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 


(HE BERE S SI ER7JT. ) 
Null deviance: 


3510.7 on 29 degrees of freedom 


Residual deviance: 
1797.8 on 26 degrees of freedom 


> plot(regpois$fit,gala$Species) 


绘图 的 结果 如 下 截图 : 
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第 3 步 : 绘制 数据 并 测试 经 验 数 据 


ppois () 是 泪 松 分 布 函 数 ， 输 入 参数 是 lambda=regpois$fit， 计 算 gala$Species 变 量 的 泪 松 分 布 如 下 : 
> p <- ppois(gala$Species, regpois$fit) 
该 值 应 该 天 然 地 接近 平均 分 布 。 


出 p 的 分 布 来 检查 该 值 是 否 符合 平均 分 布 : 


> hist(p,breaks-10) 


绘图 结果 如 下 截图 所 示 : 


p 的 柱状 图 


15 


0.0 0.2 0.4 0.6 0.8 1.0 


这 个 图 清楚 地 显示 该 值 不 是 平均 分 布 的 。 


一 个 给 


现在 我 们 进行 Kolmogorov-Smirnov 检 验 ， 检验 经 验 数 据 是 否 符合 一 个 给 定 的 分 布 。 


Kolmogorov-Smirnov 检 验 是 对 拟 合 优 度 的 检验 ， 它 通常 用 来 检验 一 个 从 未 知 分 布 中 随机 抽取 的 样本 是 否 符 合 一 个 已 知 的 
特定 分 布 函数 。 我 们 也 通常 用 Kolmogorov-Smirnov 检 验 来 检验 方差 分 析 中 的 正 态 性 假设 。 


Kolmogorov-smirnov 检 验 是 一 个 统计 学 假设 检验 。 首 先 确定 一 个 和 零 假 设 H0， 我 们 检验 的 两 个 样本 来 自 同一 个 分 布 。 然 后 
寻找 这 个 假设 被 拒绝 的 证 据 ， 并 用 概率 的 方式 表示 这 个 证 据 。 如 果 样 本 来 自 不 同 分 布 的 可 能 性 超过 了 一 个 置信 水 平 ， 我 们 就 需要 
原 假设 被 拒绝 ， 转 而 支持 H1 假 设 ，H1 假 设 是 假设 两 个 样本 来 源 于 不 同 的 分 布 。 


为 此 ， 我 们 设计 了 一 个 由 样本 计算 的 单一 数值 ， 即 一 个 统计 量 。 设 计 的 诀 穷 是 找到 一 个 具有 不 依赖 于 我 们 未 知事 实 (例如 这 
种 情况 下 的 实际 潜在 分 布 ) 的 取 值 汽 围 的 统计 量 。 


Kolmogorov-smirnov 检 验 中 的 统计 量 是 非 音 简单 的 ， 它 只 是 两 个 样本 的 经 验 昧 积分 布 阔 数 乙 间 的 最 大 垂直 距离 。 样 本 的 
经 验 昧 积分 布 是 小 于 或 等 于 给 定 值 的 样本 值 的 比例 。 


一 个 样本 的 Kolmogorov-Smirnov 检 验 如 下 : 
> ks.test (p, "punif") 


结果 如 下 : 


One-sample Kolmogorov-Smirnov test 
data: p 
D = 0.57731, p-value = 4.134e-09 
alternative hypothesis: two-sided 


基于 上 面 的 结果 ， 我 们 能 够 较 肯定 地 得 出 结论 ， 这 个 模型 是 不 适当 的 。 
第 4 步 : 校正 离散 化 当 松 模型 
因为 浊 松 分 布 是 离散 的 ， 所 以 我 们 需要 做 一 个 校正 。 改 变 如 下 : 


p = 1/2*(F(Y)*F(Y-1)) 
; where Y are the data, 
; and F are the distribution functions coming from Poisson 


FRANDI, RIHTER F : 


> p <- O.5*(ppois(gala$Species,regpois$fit) + 
ppois (gala$Species-1,regpois$fit)) 


通过 作 图 检查 均匀 性 如 下 : 


> hist (p,breaks-10) 


作 图 结果 如 下 图 所 示 : 


p 的 柱状 图 
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校正 过 程 没有 对 结果 产生 不 同 的 影响 。 作 图 结果 清楚 地 显示 p 值 分 布 不 是 平均 的 。 
现在 再 次 进行 KolImogorov-Smirnov 检 验 来 验证 经 验 数据 是 否 符合 一 个 给 定 的 分 布 ， 命 令 如 下 : 


> ks.test (p, "punif") 


结果 如 下 : 


One-sample Kolmogorov-Smirnov test 
data: p 
D = 0.58571, p-value = 2.3e-09 
alternative hypothesis: two-sided 





第 5 步 : 用 链接 函数 训练 和 评估 模型 
我 们 应 该 用 glm () 函数 观察 广义 线性 模型 拟 合 效 果 : 


> regpois2 «- glm( Species ~ Area + Elevation + Nearest, 
family-poisson(link-sqrt), data-gala) 


输出 regpois2 的 命令 如 下 : 


> summary (regpois2) 


结果 如 下 : 


Call: 
glm (formula = Species ~ Area + Elevation + Nearest, family = poisson(link = 
sqrt), 

data - gala) 
Deviance Residuals: 


Min 1ο Median 39 Max 
-19.108 -5.129 -ᾱ 333 1.846 16.918 
Coefficients: 

Estimate Std. Error z value Pr(»|zl|) 

(Intercept) 4.1764222 0.1446592 28.871 < 2e-16 *** 
Area —0.0004844 0.0001655 πο 926 0.00343 ** 
Elevation 0.0110143 0.0003572 32.664 « 2e-16 *** 
Nearest 0.0083908 0.0065858 1.274 0.20264 
Signif. codes: ο t**«*' ο ου '*** 0.01 πι 0,05 ".* DI Τα 
(Dispersion parameter for poisson family taken to be 1) 
Null deviance: 3510.7 on 29 degrees of freedom 
Residual deviance: 1377.5 on 26 degrees of freedom 


AIC: 1546.3 
Number of Fisher Scoring iterations: 5 


第 6 步 : 用 泪 松 模型 重 评估 
考虑 离散 分 布 的 校正 过 程 被 实施 如 下 : 


> p2 «- 0.5* (ppois (gala$Species, regpois2$fit) + 
ppois(gala$Species-1,regpois2$fit)) 


通过 作 图 检查 均匀 性 如 下 : 
> hist(p,breaks-10) 
作 图 结果 如 下 图 所 示 : 


p2 的 柱状 图 
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现在 再 次 进行 KolImogorov-Smirnov 检 验 来 验证 经 验 数据 是 否 符合 一 个 给 定 的 分 布 : 


> ks .test (p2, "punif") 


一 个 Kolmogorov-Smirnov 检 测 的 样本 如 下 : 


data:  p2 
D = 0.47262, p-value = 3.023e-06 
alternative hypothesis: two-sided 


结果 仍然 没有 通过 测试 。 
第 7 步 : 用 线性 模型 重 评估 


应 用 通用 的 线性 模型 : Im () 阔 数 用 来 拟 合 线性 模型 。 该 轴 数 可 用 于 回归 、 单 层 亡 差分 析 和 协 方差 分 析 (虽然 a0v 可 能 提供 
一 个 对 这 些 功能 来 说 更 加 便捷 的 接口 ) 。 


reg 数 据 框 用 来 存储 Im () 函数 返回 的 结果 ， 命 令 如 下 : 
> reg <- lm(Species ~ Area-tElevationtNearest, data-gala) 
观察 reg 数 据 框 的 结果 ， 使 用 如 下 命令 : 


> summary (reg) 


结果 如 下 : 
CALL: 
lm(formula = Species ~ Area + Elevation + Nearest, data = gala) 
Residuals: 
Min 10 Median 30 Max 
-191.856 -33.111 -18.626 5.673 262.209 
Coefficients: 
Estimate Std. Error t value Pr(>|t|) 
(Intercept) 16.46471 23.38884 0.704 0.48772 
Area 0.01908 0.02676 0.713 0.48216 
Elevation 0.17134 0.05452 3.143 0.00415 κκ 
Nearest 0.07123 1.06481 0.067 0.94718 
Signif. codes: D sw 0.001 ww 0.01 1%" D,05 T,“ 0.1 * τα 
Residual standard error: 80.84 on 26 degrees of freedom 
Multiple R-squared: 0.5541, Adjusted R-squared: 0.5027 
F-statistic: 10.77 on 3 and 26 DF, p-value: 8.817e-05 
绘制 reg 效 据 框 如 下 : 


> plot (reg) 


剩余 残 差 与 拟 合 图 如 下 : 
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Im(Species ~ Area + Elevation + Nearest) 


正 态 Q-Q 线 性 模型 图 如 下 : 
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线性 模型 尺度 -位 置 图 如 下 所 示 : 
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Im(S5pecies ~ Area + Elevation + Nearest) 


MERIA TAFARI — 1 88386, 
reg2istE Fate t hil m eR BASLER : 


> reg2 <- lm(sqrt (Species) ~ AreatElevation-tNearest, data-gala) 


观察 reg 数 据 框 的 结果 如 下 : 


> summary(reg2) 


结果 如 下 : 
Call: 
lm(formula = sqrt(Species) ~ Area + Elevation + Nearest, data = gala) 
Residuals: 
Min 10 Median 3Q Max 
-8.8057 -2. 1775 -0.2086 1.3943 8.8730 
Coefficients: 
Estimate Std. Error t value Pr(»]|t|) 
(Intercept) 3.744e-00 1.072e-00 3.492 0.001729 ** 
Area -2.253e-05 1.227e-03 -0.018 0.985485 
Elevation 9.795e-03 2.499e-03 3.920 0. 000576 *** 
Nearest 2.002e-02 4. 8809-02 0.410 0.685062 
Signif. codes: 0 '***' 0.001 '**' 0.01 '** 0.05 '.' 0.1 ' * 1 
Residual standard error: 3.705 on 26 degrees of freedom 
Multiple R-squared: 0.5799, Adjusted R-squared: 0.5315 
F-statistic: 11.96 on 3 and 26 DF, p-value: 4.144e-05 


现在 绘制 reg2 数 据 框 : 


> plot (reg2) 


残 笑 与 拟 合 图 如 下 : 


残 差 与 拟 合 值 
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Im(sqrt(5pecies) ~ Area + Elevation + Nearest) 


线性 模型 正 态 Q-Q 图 如 下 : 
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站 松 回归 尺度 -位 置 图 如 下 : 
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线性 模型 尺度 -位 置 图 如 下 : 
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Im(sqrt(5pecies) ~ Area + Elevation + Nearest) 


让 我 们 进行 Shapiro 检 测 。 给 定 n 个 真实 观测 值 的 样本 X1，...，Xn，Shapiro 一 Wilk 检 测 (Shapiro and Wilk, 1965) 是 一 
个 针对 数据 是 独立 同 分 布 和 正 态 性 的 复合 假设 检验 ， 即 对 于 未 知 的 ku 和 某 个 o > 0 的 N (u, 02) 。 命 令 如 下 : 


> shapiro.test (reg2$res) 


结果 如 下 : 


Shapiro-Wilk normality test 
data:  reg2$res 
W = 0.9633, p-value = 0.375 


现在 使 用 log 函 数 进 行 变 换 。 
reg3 数 据 框 用 来 存储 从 Im () 函数 返回 的 结果 : 


> reg3 <- lm(log(Species) ~ AreatElevation-tNearest, data-gala) 


观察 reg3 数 据 框 的 结果 如 下 : 


> summary (reg3) 


结果 如 下 : 
Call: 
lm(formula = log(Species) ~ Area + Elevation + Nearest, data = gala) 
Residuals: 
Min 1ο Median 30 Max 
-2.0739 -0.5161 0.3307 0.7472 1.6271 
Coefficients: 
Estimate Std. Error t value Pr(»|t|) 
(Intercept) 2.3724325 0.3448586 6.879 2.65e-07 大 大 大 
Area -0.0002687 0.0003946 -0.681Ι 0.50197 
Elevation 0.0029096 0.0008039 3.620 0.00125 ** 
Nearest 0.0133869 0.0157001 0.853 0.40163 
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 
Residual standard error: 1.192 on 26 degrees of freedom 
Multiple R-squared: 0.4789, Adjusted R-squared: 0.4187 
F-statistic: 7.964 on 3 and 26 DF, p-value: 0.0006281 
绘制 reg3 数 据 框 如 下 : 
> plot (reg3) 
残 差 与 拟 合 图 如 下 : 
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Im(log(Species) ~ Area + Elevation + Nearest) 


线性 模型 正在 Q-Q 图 如 下 : 
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Im(log(Species) ~ Area + Elevation + Nearest) 


线性 模型 尺度 -位 置 图 如 下 : 
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进行 Shapiro 检 测 如 下 : 
> shapiro.test (reg3$res) 


结果 如 下 : 


Shapiro-Wilk normality test 
data:  reg3$res 
W = 0.91925, p-value = 0.02565 


第 3 草 


i 


本 章 将 涵盖 如 下 内 容 : 
- 层次 聚 类 : 世界 银行 样本 数据 集 


层次 聚 类 : 1999 一 2010 年 间 亚 马 逊 雨林 的 烧毁 情况 


:二 元 聚 类 : 数学 测试 
.下 均值 聚 类 : 欧洲 各 国 的 蛋白 质 消费 情况 


.上 均值 聚 类 : 粮食 


层次 聚 类 : 层次 聚 类 是 最 重要 的 无 监督 学 习 方 法 之 一 。 给 定数 据 氮 集 的 层次 聚 类 结果 是 以 二 又 树 〈 系 统 树 图 ) 的 形式 展现 
的 。 在 二 叉 树 中 ， 叶 节点 代表 了 数据 点 ， 中 间 节 点 代表 了 不 同 大 小 的 聚 类 艇 。 每 一 个 对 象 都 被 指派 给 一 个 独立 的 艇 。 所 有 艇 的 评 
估 是 基于 两 两 三 点 间 的 距离 兴 阵 。 使 用 距离 数值 来 构建 距离 算 阵 。 艇 对 之 间 的 距离 用 其 最 短 距离 来 表示 。 需 要 合并 的 艇 对 的 距离 
值 需 要 被 移 除 出 超 阵 ， 并 合 二 为 一 。 合 并 后 的 艇 的 距离 需要 使 用 其 他 艇 来 评估 ， 之 后 再 更 新 距离 类 阵 。 该 过 程 被 不 断 重 复 直 到 距 
离 矩 阵 缩 减 成 一 个 唯一 的 元 素 。 
次 聚 类 能 够 产生 对 和 象 的 排序 。 这 对 富 合 信 息 的 数据 展示 很 有 帮助 。 更 小 的 艇 对 信息 的 友 据 更 有 帮助 。 层 次 聚 类 的 主要 缺点 
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是 ， 如 果 对 象 在 早期 争锋 误 地 分 组 了 ， 没 有 对 对 象 重 定位 的 措施 。 使 用 不 同 的 禾 间 距离 度量 方法 可 能 产生 不 同 的 聚 类 结果 。 


k 均 值 聚 类 : k 均 值 聚 类 算法 是 用 来 估计 K 组 分 类 的 中 心 的 。k 均 值 聚 类 是 无 监督 的 ， 非 确定 性 的 ， 天 然 递归 的 。 该 方法 产生 
了 确定 数量 的 互相 分 离 的 局 平 (无 结构 的 ) 艇 。K 指 的 就 是 簇 的 数量 。 这 些 艇 基于 当前 的 数据 生成 ， 每 个 簇 人 至少 有 一 个 数据 点 。 
这 些 艇 性质 上 是 不 重 革 的 ， 无 结构 的 。 一 开始 数据 点 被 随机 指派 给 K 个 禾 。 因 此 在 聚 类 早期 阶段 ， 不 同 儿 中 的 数据 点 分 布 几乎 是 
相同 的 。 在 聚 类 的 过 程 中 ， 如 果 一 个 数据 点 靠近 它 目 己 的 艇 ， 它 会 保持 原样 。 如 果 一 个 数据 点 不 靠近 它 目 己 的 艇 ， 它 会 被 转移 到 
它 最 近 的 艇 中 。 访 步骤 对 所 有 数据 点 重复 进行 ， 直 到 没有 数据 点 从 一 个 驴 移 动 到 另 一 个 艇 。 到 此 为 止 ， 聚 类 结果 稳定 下 来 ， 聚 类 


HZ HE+ 


过 程 停 止 。 以 篮 内 和 簇 间 的 距离 和 内 聚 力 为 度量 ， 初 始 划 分 方式 的 选择 很 大 程度 上 影响 了 最 终 的 聚 类 结果 。 


相 比 层次 聚 类 ，k 均 值 聚 类 最 大 的 优势 在 于 计算 时 间 消 耗 较 低 。 主 要 的 挑战 是 确定 合适 的 复数 量 比 较 困 难 。 


3.2 ”层次 聚 类 : 世界 银行 样本 数据 集 
创建 世界 银行 的 一 个 主要 目标 是 对 抗 和 消除 贫困 。 在 这 个 不 断 友 展 的 世界 中 ， 世 界 银行 持续 的 友 展 并 精细 地 调整 它 的 政策 ， 
已 经 帮助 这 个 机 构 逐 渐 实 现 了 消除 贫困 的 目标 。 消 除 贫 困 的 成 果 以 下 指标 的 改进 衡量 ， 这 些 指 标 包括 健康 、 教 育 、 了 卫生、 基础 设 


施 以 及 其 他 需要 用 于 改进 穷人 生活 的 服务 。 与 此 同时 ， 友 展 成 果 必 须 保证 以 一 种 环保 的 、 全 社会 的 、 经 济 可 持续 的 万 式 达 成 。 


准备 工作 


为 了 进行 层次 聚 类 ， 我 们 需要 使 用 从 世界 银行 收集 的 数据 集 。 
第 1 步 : 收集 和 摘 述 数据 


该 任务 使 用 名 为 WBClust2013 的 数据 集 。 该 数据 以 标准 格式 存储 在 名 为 WBClust2013.csv 的 CSV 格 式 的 文件 中 。 其 有 80 行 
数据 和 14 个 变量 。 数 什 型 变量 如 下 : 


: new.fotest 

: Rural 

: log.CO2 

: log; GNI 

: log. Energy.2011 
: LifeExp 

: Fertility 

: InfMort 

: log. Exports 

: log. Imports 

: CellPhone 

: RuralWater 

: Pop 

非 数 值 型 变量 是 : 


” Country 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 
版 本 信息 : 本 节 的 代码 在 R 3.2.3 版 本 中 测试 (2015-12-10) o 


让 我 们 探索 数据 并 理解 变量 间 的 关系 。 我 们 通过 导入 名 为 WBClust2013.csv 的 CSV 文 件 开始 。 存 储 数据 到 wbclust 数 握 框 


> wbclust-read.csv("d:/WBClust2013.csv",header-T) 


一 步 输出 wbclust 数 据 框 ，head () 函数 返回 wbclust 数 据 框 。wbclust 数 据 框 作为 一 个 输入 参数 传 入 : 


> head(wbclust) 


结果 如 下 : 

Country new. 
1 china -5. 
2 India -2. 
3 united States  -1. 
4 Indonesia 4. 
5 Brazil 3. 
6 Pakistan 6. 


log.Imports CellPhone Ruralwater 
.259900 88.70833 
«408213 70.78318 
«844193 95. 32955 
«216865 121. 54341 
.535485 135. 30505 
«942568 70.13038 
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第 3 步 : 转换 数据 


中 心 化 变量 和 创建 z 值 是 两 个 常见 的 用 于 归 一 化 数据 的 数据 分 析 手 段 。 上 面 提 到 的 数值 型 变量 需要 创建 z 值 。scale () ERZX 
是 一 个 通用 的 函数 ， 其 默认 方法 中 心 化 并 比例 缩放 一 个 数值 化 矩阵 的 列 。 数 据 框 wbclust 被 传 给 该 比例 函数 。 只 有 数据 框 中 数值 


forest Rural 
929375 46.832 
735634 68.006 
688899 18.723 
636429 47.748 
222813 14.829 
053449 62.140 


log.CO2 . log.GNI log.Energy. 2011 
1.83973304 38.651724 7.615477 75.19951 
0.56883558 7.346010 6.419537 66.21085 
2.87153773 10.865707 8.858293 78.74146 
0.64354020 8.137396 6.753775 70.60724 
0.81104934 9.362203 7.223405 73.61788 
0.03161348 7.130899 6.177147 66.43588 

Pop 


84.9 1357380000 
90.7 1252139596 
98.0 316128839 
76.4 249865631 
85.3 200361925 
89.0 182142594 


化 的 变量 会 被 缩放 。 结 果 存 储 在 wbnorm 数 据 框 中 。 


> wbnorm «- scale(wbclust[,2:13]) 


> wbnorm 


结果 如 下 : 


new. forest 
-1. 5868006 
-0, 8025212 
-0. 5454767 
1.0078203 
0. 6606817 
1.3557946 
1.6450615 
0. 3497634 
-0.1747622 
-0. 2368652 
0. 5746262 
-1.182239€ 
1.1 349013 
-1. 8746588 
-2. 0615030 
-0. 5644195 
-11.2162839 
0. 2801866 
-0. 9229715 
-0. 9411997 
-1. 2980378 
-0. 1307375 
ο. 2599093 
1. 0048703 
0. 3322161 
-1.5639512 
-0.691154€ 
0. 5232651 
0. 7039651 
2. 3249406 
-0. 1307375 
-0, 5276118 
-0.4797723 


l1.] 
[2] 
[3.1 
[4 ] 
[2.1] 
[6, ] 
[7,1 
[8] 
[9, ] 
[10, ] 
[11, ] 
[12, ] 
[13,] 
[14, 
[15,] 
[16, ] 
[17,] 
[18, ] 
[19, ] 
[20,1] 
[21] 
[22, ] 
[23,] 
[24,] 
[25, ] 
[26, ] 
[27,] 
[28, ] 
[29, ] 
[30, ] 
[31, ] 
[32,] 
[33,] 


Rural 

0. 33809236 

1. 35749860 

-1.01519472 
0. 38210240 

-1, 20266791 
1. 07508446 

ο. 67866475 

1. 32095712 

-0. 657 07 5060 
-1. 55508378 
-0. 89069320 
0. 74900349 

2. 00282406 

1. 34233316 

0. 82641943 

-0. 70769693 
-0. 58637343 
0. 58964604 

-0. 90821771 
-1. 05443178 
-0. 40901003 
-0. 17319952 
-1. 06199043 
1. 44406195 

-0. 75550416 
-0. 91178038 
-0, 43731885 
1. 70481118 

-0. 44868089 
1. 28691914 

-1. 02458235 
-0. 43674112 
ο. 04768627 


所 有 的 数据 框 都 有 rownames 属 性 。 
一 列 被 传递 给 rownames () Ε΄ ἕν. 


Ἴοα. (02 
0. 7338514701 
-0. 24330397 
1.52716910 
-0.18586705 
-0. 05707 5343 
-0. 65635910 
-1. 08103307 
-1. 25802465 
1. 25049678 
1. 03273482 
0. 35853091 
-0.70159339 
-2. 02269355 
-0. 21681716 
0. 08947721 
1. 02684921 
0. 42838526 
0.4837 3630 
0.65157461 
0.91454541 
0. 8104 5102 
1.02062379 
1.20295976 
-1.73971591 
-0. 25947626 
0. 68271981 
ο. 78693642 
-1. 37793791 
0. 26734982 
-1. 35457894 
1. 39001657 
0. 34646874 
-0. 27296128 


rownames () AŽ RKAS &eXBIEEZSSEERBJTI ERR. SmtEwbclustL IRE 


109. GNI log. Energy. 2011 


0. 032982395 
-ο. 869172134 
1. 562685765 
-0. 322381497 
0. 323872116 
-1. 017798652 
-0. 550027966 
-1. 300715181 
0. 586202385 
1. 498270384 
0. 399324140 
-0. 424525130 
-1. 788005101 
-0. 869172134 
-0. 417534229 
1. 460760873 
0. 472760143 
-0. 020238292 
1. 408179559 
1. 34676929% 
1. 280754422 
0. 216483671 
1. 042015543 
-1. 560358631 
0. 173495699 
1. 162638223 
-0. 279306870 
-1. 268194911 
-0. 064126848 
-0.910502419 
1. 539876352 
0.080812552 
-0.433957743 


0.4788446547 
-0.7378944563 
1.7432739991 
-0.3978432411 
0.0799536232 
-0.9844993561 
-0.5744934561 
-1. 8248802689 
1.41 90202390 
1. 0649522402 
0. 2110563885» 
-1.1103654624 
-1. 2227708545 
-0. 6086747631 
-0. 2637797 590 
1. 1200997628 
0.1976392919 
0. 1108491 004 
1.1353905714 
0. 8673628225 
0. 8133720930 
0. 7846175740 
1.4423618002 
-1. 0590872047 
-0. 6463659711 
0. 7642100131 
0. 7940268971 
-0. 9876392491 
-0.1365866710 
-1. 2946081464 
1.7858879570 
-ο, 0009236421 
-0. 8698178137 


1.6630 10 
2.5050 41. 
1.8805 3. 
2.3700 24. 
1.8110 12. 
3.2640 69. 


LifeExp 
0.442646915 
-0. 5932 32631 
0. 8508 31828 
-0. 086579641 
0. 2603/4720 
-0. 567 300156 
-2. 218369066 
-0, 122580415 
-0. 1034 36031 
1.352672723 
0. 665706675 
-0. 3232 3244B 
-0. 967184767 
0. 489570472 
-0. 052006755 
1.098744717 
0.403801605 
0. 32607445? 
1.291565851 
1.168/ 337293 
1. 334290068 
-1.758631201 
1.153555388 
-1.21144361) 
0.2787 2084? 
1.26992266? 
-0. 0477 54009 
-1.184161940 
-0. 05489626? 
-1.094182501 
1.138545697 
-0. 243922811 
-0. 082444949 


4 
9 
5 
3 
0 


LifeExp Fertility InfMort log.Exports 
-9 


. 350966 
.172485 
. 604613 
.271911 
.475628 
. 636213 
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Fertility 
-0. 822234101 
-0.159983330 
-0. 651165827 
-0. 266163604 
-0. 05829056 

0. 4316086270 
2. 590481349 
-0. 393580130 
-0. 879650240 
-1. 021224058 
-0. 387287961 
0. 289120282 
1. 520812500 
-0. 739649464 
0. 0775460076 
-1.044819694 
-0. 509985270 
-1.019651015 
-0. 549311330 
-0. 635828664 
-1. 029089270 
-0. 233129803 
-1.110100955 
2. 028118682 
-0. 308635839 
-1. 092010967 
-0. 926054991 
1. 3768/9119 
0.087770852 
1.402047797 
-0. 863919815 
1.083506/06 
-0. 001892567 


> rownames (wbnorm)-wbclust[,1] 
» rownames (wbnorm) 


调用 rownames (wbnorm) 方法 显示 第 一 列 的 数值 。 结 果 如 下 : 


[1] "china" "India" "united States" "Indonesia" "Brazil" 

[6] "Pakistan" "Nigeria" "Bangladesh" "Russian Federation" X "Japan" 

[11] "Mexico" "Philippines" "Ethiopia" "vietnam" "Egypt, Arab Rep." 
[16] "Germany" "Turkey" "Thai land" "France" "united Kingdom" 
[21] "Italy" "south Africa" "Korea, Rep." "Tanzania" "colombia" 

[26] "Spain" "Ukraine" "Kenya" "Algeria" "Sudan" 

[31] "canada" "Iraq" "Morocco" "Peru" "Uzbekistan" 
[36] "Malaysia" "Saudi Arabia" "Nepal" "Ghana" "Mozambique" 
[41] "Australia" "Cameroon" "Angola" "sri Lanka" "Cote d'Ivoire" 
[46] "chile" "Kazakhstan" “Nether lands” "Ecuador " "Guatemala" 

[51] "cambodia" "Zambia" "Zimbabwe" "senegal" "Belgium" 

[56] "Greece" "Tunisia" "Bolivia" "Czech Republic" "Portugal" 

[61] "Dominican Republic" "Benin" "Haiti" "Hungary" "Sweden" 

[66] "Belarus" "Azerbaijan" "united Arab Emirates" "Austria" "Tajikistan" 
[71] "Honduras" "Switzerland" "Israel" "Bulgaria" "serbia" 

[76] "Togo" "Paraguay" "Jordan" "El Salvador" "Nicaragua" 


第 4 步 : 训练 并 评估 模型 效果 





下 一 步 是 训练 模型 。 首 先 使 用 dist () 函数 计算 距离 矩 哇 。 使 用 特定 的 距离 度量 方法 计算 数据 中 阵 行 间 的 距离 。 使 用 的 距离 
度量 可 以 是 欧式 距离 、 最 大 距离 、 曼 哈 屯 距离、 堪培拉 距离 、 二 进 制 距离 ， 或 闵可夫 斯 基 距 离 。 这 里 的 距离 度量 使 用 欧式 距离 。 
使 用 欧式 距离 计算 两 个 向 量 间 的 距离 为 sqrt (sum ( (x i-y i) ^2) ) 。 结 果 被 存储 在 一 个 新 的 数据 框 dist1 中 。 


> dist1 <- dist(wbnorm, method="euclidean") 


下 一 步 是 使 用 Ward 方 法 进行 聚 类 。hclust () 辫 数 对 一 组 不 同 的 n 个 对 象 进行 聚 类 分 析 。 第 一 阶段 ， 每 个 对 象 被 指派 给 它 目 
己 的 复 。 之 后 每 个 阶段 ， 算 法 欠 代 聚合 两 个 最 相似 的 艇 。 这 个 过 程 不 断 持续 直到 只 剩 一 个 禾 。hclust () AKEKE JASA 
阵 的 形式 提供 数据 。dist1 数 据 框 被 作为 输入 传 入 。 默 认 使 用 全 链接 算法 。 此 外 还 可 以 使 用 不 同 的 聚集 方法 ， 包 括 ward.D、 


ward.D2、single、complete 和 average。 


> clustl <- hclust(distl,method-"ward.D") 
> clust1 


输入 clust1 命 令 可 显示 所 使 用 的 聚集 方法 ， 计 算 距 离 的 方法 ， 以 及 数据 对 象 的 数量 。 结 果 如 下 : 
call: 
hclust(d = disti, method = "ward.D") 


Cluster method : ward.D 
Distance : euclidean 
Number of objects: 80 


第 5 步 : 绘制 模型 


plot () 遂 数 是 一 个 通用 的 绘制 R 语 言 对 象 的 溺 数 。 这 里 plot () 函数 用 来 绘制 系统 树 图 : 


> plot(clusti,labels- wbclust$Country, cex-0.7, 
xlabz-"",ylabz"Distance",main-"Clustering for 80 Most Populous Countries") 


结果 如 下 : 


人 口 最 多 的 80 个 国家 的 聚 类 结果 
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"ward.D") 


hclust (*, 


rect.hclust () ΡΑΛΛΥ AER, HERRERO. f&SBbEIEITUCER T SER E4553), ZR CERES 


权 干 上 绘制 长 方形 。 


clust1 对 象 以 及 需要 形成 的 篮 的 数量 作为 输入 变量 传 入 孙 数 。 


> rect.hclust(clusti1,k-5) 


结果 如 下 : 


人 口 最 多 的 80 个 国家 的 聚 类 结果 
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hclust (*, "ward.D") 


需要 形成 的 艇 的 数量 


里 ，clust1 对 象 以 及 


| 到 不 同 的 复 中 。 这 


宝 
A 


度 将 树 中 的 元 素 切 


—— 
E 
[m 


cuts () AAE FRERE Bed VR 


作为 输入 变量 传 入 函数 。 


=5) 


> cuts=cutree (clust1,k 


> cuts 


结果 如 下 : 


China India United States Indonesia Brazil 
1 2 1 2 2 
Pakistan Nigeria Bangladesh Russian Federation Japan 
3 4 3 1 1 
Mexico Philippines Ethiopia vietnam Egypt, Arab Rep. 
2 2 4 5 2 
Germany Turkey Thailand France united Kingdom 
5 1 5 1 1 
Italy South Africa Korea, Rep. Tanzania Colombia 
1 1 5 4 2 
Spain Ukraine Kenya Algeria Sudan 
1 5 4 2 3 
canada Iraq MOrOCCO Peru Uzbekistan 
1 2 2 2 2 
Malaysia Saudi Arabia Nepal Ghana Mozambique 
5 1 3 3 4 
Australia Cameroon Angola Sri Lanka Cote d'Ivoire 
1 4 4 3 4 
chile Kazakhstan Nether lands Ecuador Guatemala 
1 : d 5 2 2 
cambodia zambia zimbabwe senegal Belgium 
3 4 3 3 5 
Greece Tunisia Bolivia czech Republic Portugal 
1 5 2 5 1 
ominican Republic Benin Haiti Hungary Sweden 
2 3 3 5 5 
Belarus Azerbaijan United Arab Emirates Austria Tajikistan 
5 2 5 5 3 
Honduras Switzer land Israel Bulgaria Serbia 
3 5 1 5 1 
Togo Paraguay Jordan E] Salvador Nicaragua 
4 3 5 2 3 
人 日 AL 一 ΛΝ «εκ — " 
导 到 每 个 禾 的 国家 列表 : 
for (1 in 1:5)( 
print (paste ("Countries in Cluster ",1i)) 
print (wbclust$Country[cuts--i]) 
print ( "Ww n ) 
) 
结果 如 下 : 
[1] "Countries in Cluster 1” 
[1] china united States Russian Federation Japan Turkey 
[6] France united Kingdom Italy South Africa Spain 
[11] canada Saudi Arabia Australia chile Kazakhstan 
[16] Greece Portugal Israel Serbia 
80 Levels: Algeria Angola Australia Austria Azerbaijan Bangladesh Belarus Belgium Benin Bolivia ... zimbabwe 
[1] ” ^ 
[1] "countries in cluster 2" 
[1] India Indonesia Brazil Mexico Philippines 
[6] Egypt, Arab Rep. colombia Algeria Iraq Morocco 
[11] Peru uzbekistan Ecuador Guatemala Bolivia 
[16] pominican Republic Azerbaijan E] Salvador 


80 Levels: Algeria Angola Australia Austria Azerbaijan Bangladesh Belarus Belgium Benin Bolivia ... Zimbabwe 
[1] "countries in Cluster 3" 

[1] Pakistan Bangladesh Sudan Nepal Ghana Sri Lanka Cambodia 
[10] Benin Haiti Tajikistan Honduras Paraguay Nicaragua 
80 Levels: Algeria Angola Australia Austria Azerbaijan Bangladesh Belarus Belgium Benin Bolivia ... zimbabwe 
[1] "countries in cluster 4" 

[1] Nigeria Ethiopia Tanzania Angola 

[8] cote d'Ivoire zambia Togo 
80 Levels: Algeria Angola Australia Austria Azerbaijan Bangladesh Belarus Belgium Benin Bolivia ... zimbabwe 


[1] "countries in cluster 5” 


Zimbabwe ^ Senegal 


Mozambique Cameroon 


Kenya 


[1] vietnam Germany Thai land Korea, Rep. Ukraine 

[6] Malaysia Nether lands Belgium Tunisia Czech Republic 
[11] Hungary Sweden Belarus united Arab Emirates Austria 

[16] Switzerland Bulgaria Jordan 


80 Levels: Algeria Angola Australia Austria Azerbaijan Bangladesh Belarus Belgium Benin Bolivia ... zimbabwe 


3.3 ”层次 聚 类 : 1999 ~ 2010*fENL HP RRTABJS eR IE: 


1999 ~ 20104, 330003E753&EB (85500 平 方 公里 ) ， 即 2.8% 的 亚马逊 雨林 被 烧毁 。 这 一 结果 是 被 NASA 领 导 的 研究 项 目 
发 现 的 。 该 研究 的 主要 目的 是 衡量 森林 树冠 下 暗 火 的 曼 延 程度 。 该 研究 友 现 火灾 烧毁 的 森林 比 用 于 农耕 而 砍伐 的 森林 面积 大 很 
多 。 然 而 ， 和 森林 烧毁 情况 和 火灾 之 间 没 有 建立 起 联系 。 


如 何 建立 火灾 和 森林 烧毁 情况 之 间 的 联系 ， 需 要 基于 NASA 的 Aqua 卫星 上 的 大 气 红外 探测 仪 (AIRS) 设备 的 湿度 数据 。 火 
灾 频 率 与 夜间 的 低 湿 度 相 吻 合 ， 低 湿度 使 得 地 表 的 低 强 度 火灾 能 够 持续 燃烧 。 


准备 工作 


为 了 进行 层次 聚 类 ， 我 们 应 该 使 用 采集 于 亚马逊 雨林 (1999 ~ 2010 年 ) 的 数据 集 。 
第 1 步 : 收集 和 摘 述 数据 


该 任务 使 用 名 为 NASAUnderstory 的 数据 集 。 该 数据 以 标准 格式 存储 在 名 为 NASAUnderstory.csv 的 CSV 格 式 的 文件 中 。 其 
中 包含 64 行 数据 和 32 个 变量 。 数 值 型 变量 如 下 : 


: PlotID 
: SPHA 
: BLIT 
: ASMA 
: MOSS 
: LEGR 
: CHCA 
: GRAS 
: SEDG 
: SMIR 
- PTAQ 
: COCA 
‘VAAN 
: GAHI 
: ARNU 


: LYOB 


: PIMA 
: RUBU 
: VAOX 
HAGSP 
: COCO 
: ACRU 
: TRBO 
: MACA 
: CLOB 
: STRO 
: FUNG 
: DILO 
: ERIO 
: GATR 
非 效 全 型 数据 如 下 : 
- Overstory Species 


- Labels 


具体 实施 步骤 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 
版 本 信息 : 本 节 的 代码 在 R 3.2.3 版 本 中 测试 (2015-12-10) 。 


让 我 们 探索 数据 并 理解 变量 间 的 关系 。 我 们 从 导入 名 为 NASAUnderstory.csv 的 文件 开始 ， 将 该 数据 存储 到 NASA 数 据 框 


> NASA = read.csv("d:/NASAU nderstory.csv",header-T) 


下 一 步 ， 我 们 应 该 获取 每 一 个 物种 列 标签 的 长 版 本 : 


> NASA.lab-zNASAS$Labels 


之 后 ， 输 出 NASA.lab 数 据 框 。 这 包含 了 每 一 个 物种 的 完整 名 字 。 


[1] sphagnum Moss Brown Litter Big-leaved Aster Mosses (Non-Sphagnum) Labrador Tea 
[6] Leatherleaf Grasses (unidentified) Sedges (unidentified) Bog False Solomon Seal Bracken Fern 
[11] Bunchberry Lowbush Blueberry Creeping Snowberry wild Sarsaparilla Ground Pine 
[16] spruce (Black) Brier Small cranberry Maple (Mountain) Hazelnut (Beaked) 
[21] Maple (Red) Starflower Canadian Mayflower Blue-bead Lily Twisted Stalk 
[26] Fungi Bush Honeysuckle Cotton Grass Bedstraw (Narrow Leaves) 
[31] 
[36] 
[41] 
[46] 
[51] 
[56] 
[61] 
30 Levels: Bedstraw (Narrow Leaves) Big-leaved Aster Blue-bead Lily Bog False Solomon Seal Bracken Fern Brier Brown Litter ... wild Sarsaparilla 


接 下 来 把 整个 数据 内 容 传递 给 NASA 数 据 框 : 


> ΝΑΘΑΞΝΑΘΑΙ, -32] 


输出 NASA 数 据 框 可 以 把 整体 的 数据 内 容 显 示 出 来 。 


> NASA 


结果 如 下 : 


PlotID Overstory.Species SPHA BLIT ASMA MOSS LEGR CHCA GRAS SEDG SMTR PTAQ COCA VAAN GAHI ARNU LYOB PIMA RUBU VAOX ACSP COCO ACRU TRBO MACA 
0 


1 2 Aspen 68 14 0 3 33 5 5 0 14 0 0 4 28 ο 0 1 0 6 0 0 0 0 
2 3 Spruce ο 6 18 2 0 0 5 0 0 2 0 0 0 7 0 0 6 0 2 1 2 2 2 
3 12 Aspen 60 1 0 0 5 9 12 1 14 0 0 0 2 0 0 3 0 4 0 0 0 0 0 
E 14 Aspen 16 14 ο 72 14 : d 2 0 13 0 0 5 7 ο 0 2 0 1 0 0 0 0 0 
5 15 Aspen 68 7 0 30 27 8 4 0 12 0 0 3 13 0 0 3 0 3 0 0 0 0 0 
6 16 Spruce 0 14 14 3 0 0 2 0 0 1 0 0 0 2 1 0 1 ο 17 6 10 1 0 
7 18 Aspen 62 7 0 3 6 12 4 0 0 0 0 0 0 0 0 13 0 5 0 0 0 0 0 
8 19 Aspen 62 ο 0 6 28 1 0 0 0 0 0 0 0 0 15 0 5 0 0 0 0 0 
9 20 Spruce 0 5 8 14 0 0 4 6 0 14 10 3 0 0 5 0 0 0 1 8 1 1 0 
10 21 Spruce 0 16 26 5 0 0 1 0 0 18 6 10 0 10 11 0 3 0 1 5 5 4 4 
11 36 spruce 0 25 38 3 0 0 5 3 0 6 7 0 0 0 0 0 1 0 0 3 6 4 4 
12 38 Aspen 82 10 0 10 24 12 8 0 6 0 0 4 2 0 0 2 0 1 0 0 0 0 0 
13 39 Aspen 60 3 0 34 24 0 5 ο 9 0 1 5 4 0 1 6 0 4 0 0 0 0 0 
14 41 Aspen 72 17 0 4 6 0 3 0 5 0 0 5 6 0 1 1 0 0 0 0 0 0 0 
15 42 Aspen 34 14 0 36 15 1 0 5 6 0 4 9 8 0 1 4 0 2 0 0 0 1 0 
16 43 Aspen 32 13 0 34 28 3 0 0 6 0 0 5 5 0 0 2 0 1 0 0 0 0 0 
17 45 Aspen 55 25 0 8 7 4 0 10 4 0 0 5 3 0 0 0 0 2 0 0 0 0 0 
18 47 Aspen 64 8 0 5 9 8 1 32 20 0 0 5 4 0 0 2 ο 5 0 0 0 0 0 
19 48 Aspen 64 12 0 13 6 0 10 2 10 0 0 0 1 0 7 1 0 0 0 0 0 0 0 
20 49 Aspen 48 5 0 6 1 0 5 14 5 0 1 2 2 0 0 0 ο 1 0 0 0 0 0 
21 50 Aspen 38 18 0 38 11 0 2 6 4 0 2 0 3 0 0 0 0 1 0 0 1 0 0 
22 51 Aspen 74 3 0 2 34 17 1 0 2 0 0 0 0 0 0 6 0 3 0 0 0 0 0 
23 52 Aspen 86 3 0 3 36 9 17 1 0 0 0 0 4 0 0 z 0 2 0 0 0 0 0 
24 54 Aspen 62 16 0 0 22 10 5 0 7 1 0 4 3 0 0 1 0 2 0 0 0 0 0 
25 55 Aspen 38 30 0 18 4 2 0 2 6 0 0 5 6 0 0 4 ο 2 0 0 0 0 0 
26 56 Asper! 68 13 ο 6 34 5 ο 5 2 ο ο 2 3 ο 0 6 ο 4 ο ο ο ο 0 
27 57 Aspen 72 5 0 4 17 20 0 14 0 0 0 0 4 0 0 3 0 4 0 0 0 0 0 
28 62 Aspen 66 1 0 12 7 20 17 6 0 0 0 0 0 0 0 d 0 E 0 0 0 0 0 
29 63 Aspen 56 8 0 1 12 12 6 0 0 0 0 0 0 0 0 8 0 3 0 0 0 0 0 
30 64 Aspen 56 ο 0 6 6 24 0 34 0 0 0 0 0 0 0 7 ο 4 0 0 0 0 0 
31 68 Aspen 62 8 0 9 4 5 1 10 1 0 0 0 5 0 0 1 ο 5 0 0 0 0 0 
32 69 Spruce 1 15 11 5 0 0 2 0 0 2 17 7 1 1 3 0 0 0 0 2 1 1 3 
33 71 Spruce 1 20 16 5 0 0 2 2 0 4 5 3 0 4 2 0 3 0 0 1 2 0 2 
34 72 Spruce 0 32 14 4 0 0 1 0 0 0 4 0 0 5 5 0 4 0 3 2 2 5 4 


第 3 步 : 转换 数据 
接 下 来 进行 数据 归 一 化 。scale () 函数 将 中 心 化 并 拉 伸 所 有 先前 提 到 的 数值 型 变量 列 : 


> NASAscale «- scale(NASA[,3:31]) 


这 会 拉 伸 缩 NASA 数 据 框 中 第 3 ~ 31 列 的 所 有 数值 型 变量 。 
输出 NASAscale 数 据 框 可 以 显示 所 有 的 拉 伸 和 中 心 化 后 的 数值 。 


> NASAscale 


结果 如 下 : 





SPHA BLIT ASMA MO55 LEGR CHCA GRAS SEDG SMTR 
[1,] 1.2641384 -0.24208432 -0.77255673 -0.50604541 2. 54875930 0.19309198 0.36896403 -0.49052647 2.6140567 
[2,] -0.9204396 -0.95979313 0.65894545 -0.58972221 -0.65297519 -0. 55782127 Ο. 36896403 -0.49052647 -0.5529735 
[3,] 1.0071292 -1.40836113 -0.77255673 -0.75707581 -0.16786391 0.79382257 2.37776818 -0. 35498626 2.6140567 
[4,] -0.4064213 -0.24208432 -0.77255673 5.26765381 0.70533641 -0.40763862 -0.49195204 -0.49052647 2. 3878403 
[5,] 1.2641384 -0.87007953 -0.77255673 1.75322820 1.96662576 0.64363992 0.08199201 -0.49052647 2.1616238 
[6,] -0.9204396 -0.24208432 Ο. 34083385 -0.50604541 -0.65297519 -0. 55782127 -0.49195204 -0.49052647 -0.5529735 
[7,] 1.0713815 -0.87007953 -0.77255673 -0.50604541 -0.07084165 1.24437052 0.08199201 -0.49052647 -0.5529735 
[8,] 1.0/13815 -1.049506/3 -U.//2556/3 -U./5/0/581 -U.U/084165 3.064/29290 -U.//8924U6 -U.4905264/ -0.5529/35 
[9,] -0.9204396 -1.04950673 -0.13633354 0.41439939 -0.65297519 -0.55782127 0.08199201 Ο. 32271478 -0.5529735 
[10,] -0.9204396 -0.06265712 1.29516864 -0.33869181 -0.65297519 -0. 55782127 -0.77892406 -0.49052647 -0.5529735 
[11,] -0.9204396 Ο.74476529 2.24950342 -0.50604541 -0.65297519 -0. 55782127 Ο. 36896403 -0.08390584 -0.5529735 
[12,] 1.7139045 -0.60093872 -0.77255673 0.07969219 1.67555898 1.24437052 1.22988009 -0.49052647 0. 8043251 
[13,] 1.0071292 -1.22893393 -0.77255673 2.08793540 1.67555898 -0. 55782127 Ο. 36896403 -0.49052647 1.4829745 
[14,] 1.3926430 0.02705648 -0.77255673 -0.42236861 -0.07084165 -0.55782127 -0.20498002 -0.49052647 0. 5781087 
[15,] 0.1718494 -0.24208432 -0.77255673 2.25528900 0.80235867 -0.40763862 -1.06589608 0.18717457 0.8043251 
[16,] 0.1075971 -0.33179792 -0.77255673 2.08793540 2.06364801 -0.10727332 -1.06589608 -0.49052647 0. 8043251 
[17,] 0.8464985 0.74476529 -0.77255673 -0.08766141 0.02618061 0.04290933 -1.06589608 0. 86487561 Ο. 3518923 
[18,] 1.1356338 -0.78036593 -0.77255673 -0.33869181 0.22022512 0.64363992 -0.77892406 3.84676019 3.9713554 
[19,] 1.1356338 -0.42151152 -0.77255673 0.33072259 -0.07084165 -0.55782127 1.80382414 -0.21944605 1.7091909 
[20,] 0.6216155 -1.04950673 -0.77255673 -0.25501501 -0.55595294 -0.55782127 Ο. 36896403 1.40703644 0. 5781087 
[21,] 0.3003540 0.11677008 -0.77255673 2.42264260 0.41426964 -0.55782127 -0.49195204 0.32271478 0.3518923 
[22,] 1.4568953 -1.22893393 -0.77255673 -0.58972221 2.64578156 1.99528376 -0.77892406 -0.49052647 -0.1005406 
[23,] 1.8424091 -1.22893393 -0.77255673 -0.33869181 2.83982607 0.79382257 3.81262829 -0. 35498626 -0. 5529735 
[24,] 1.0713815 -0.06265712 -0.77255673 -0.75707581 1.48151447 0.94400522 0.36896403 -0.49052647 1.0305416 
[25.] ϱ0.3003540 1.19333330 -0.77255673 0.74910659 -0.26488616 -0.25745597 -1.06589608 -0.21944605 Ο. 8043251 
[26,] 1.2641384 -0.33179792 -0.77255673 -0.25501501 2.64578156 0.19309198 -1.06589608 0.18717457 -0.1005406 
[27,] 1.3926430 -1.04950673 -0.77255673 -0.42236861 0.99640318 2.44583171 -1.06589608 1.40703644 -0.5529735 
[28,] 1.1998861 -1.40836113 -0.77255673 0.24704579 0.02618061 2.44583171 3.81262829 0.32271478 -0.5529735 
[29,] 0.8786246 -0.78036593 -0.77255673 -0.67339901 0.51129190 1.24437052 0.65593605 -0.49052647 -0.5529735 
[30,] 0.8786246 -1.49807473 -0.77255673 -0.25501501 -0.07084165 3.04656230 -1.06589608 4.11784060 -0.5529735 
[31,] 1.0713815 -0.78036593 -0.77255673 -0.00398461 -0.26488616 0.19309198 -0.77892406 0. 86487561 -0. 3267571 
[32,] -0.8883135 -0.15237072 0.10225016 -0.33869181 -0.65297519 -0. 55782127 -0.49195204 -0.49052647 -0.5529735 
[33,] -0.8883135 0.29619729 0.49988965 -0.33869181 -0.65297519 -0. 55782127 -0.49195204 -0.21944605 -0.5529735 
为 了 将 一 个 向 量 编码 大 需要 使 用 factor 水 数 。 如 果 目 变量 排序 是 TRUE， 因 子 等 级 将 被 排序 。 这 里 ， 我 们 将 
OverstorySpecies 列 作为 PAŽI: 





> rownames (NASAscale)-as.factor(NASAS$Overstory.Species) 


as.factor () i 


返回 多 名 的 数据 框 。 


输出 数据 框 rownames (NASAscale) 将 显示 OverstorySpecies 列 的 所 有 值 : 


> rownames (NASAscale) 


结果 如 下 : 


[1] 
[12] 
[23] 
[34] 
[45] 
[56] 


"Aspen" 
"Aspen" 
"Aspen" 
"Spruce" 
"Spruce" 
"Spruce" 


"Spruce" 
"Aspen" 
"Aspen" 
"Spruce" 
"Spruce" 
"Spruce" 


"Aspen" 
"Aspen" 
"Aspen" 


"spruce" 
"Spruce" 
"Spruce" 


"Aspen" 
"Aspen" 
"Aspen" 
"spruce" 
"Spruce" 
"Aspen" 


"Aspen" 
"Aspen" 
"Aspen" 
"spruce" 
"Spruce" 
"Spruce" 


"Spruce" 
"Aspen" 
"Aspen" 
"Spruce" 
"Spruce" 
"Aspen" 


"Aspen" 
"Aspen" 
"Aspen" 
"Spruce" 
"Spruce" 
"Aspen" 


"Aspen" 
"Aspen" 
"Aspen" 
"Spruce" 
"Spruce" 
"Aspen" 


"Spruce" 
"Aspen" 
"Aspen" 
"spruce" 
"Spruce" 


"Spruce" 
"Aspen" 

"Spruce" 
"Spruce" 
"Spruce" 


"Spruce" 
"Aspen" 

"Spruce" 
"Spruce" 
"Spruce" 


第 4 步 : 训练 








η 








ο EuleUBEXEME, dist () ΜΙΕΙΕΗΣΚΥΓΕΕΙΕΙΗΙΠΕΡΗΊΕΙΕ, (FARENE EK BSURABMEHRSES 
行 间 的 距离 。 这 里 使 用 的 距离 度量 可 以 是 欧式 距离 、 最 大 距离 、 曼 哈 顿 距离 、 堪 培 拉 距离 、 二 进 制 距离 ， 或 闵可夫 斯 基 距 离 。 
里 的 距离 度量 使 用 欧式 距离 。 欧 式 距 离 计算 两 个 向 量 间 的 距离 为 sqrt (sum ( (x i-y i) ^2) ) 。 结 果 存 储 在 一 个 新 的 数据 框 
dist1 中 。 


NAN 一 一 
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> distl <- dist(NASAscale, method-"euclidean") 


是 使 用 Ward 方 法 进行 聚 类 。hclust () 水 数 对 一 组 不 同 的 n 个 对 象 进 行 聚 类 分 析 。 第 一 阶段 ， 每 个 对 象 被 指派 给 它 目 
己 的 复 。 之 后 每 个 阶段 ， 算 法 欠 代 聚合 两 个 最 相似 的 艇 。 这 个 过 程 不 断 持续 直到 只 剩 一 个 禾 。hclust () AKEKE JASA 
TRX 


阵 的 形式 提供 数据 。dist1 数 据 框 补 传 入 。 默 认 使 用 全 链接 进 4 此 外 还 可 以 使 用 不 同 的 聚集 万 法 ， 包 括 ward.D、 


Τεκτςο 


ward.D2、single、complete 和 average。 


> clustl1 <- hclust (distli1,method-"ward.D") 
> clust1 


调用 clust1， 结 果 显 示 了 聚集 方法 、 计 算 距 离 的 方法 ， 以 及 对 象 的 数量 。 结 果 如 下 : 
Call: 


hclust(d = dist1, method = "ward.D") 


Cluster method : ward.D 
Distance : jaccard 
Number of objects: 63 


第 5 步 : 绘制 模型 
plot () 函数 是 绘制 R 对 象 的 通用 函数 。 这 里 ，plot () 函数 用 来 绘制 系统 树 图 : 


> plot (c1ustl,labels= NASA[,2], cex-0.5, 
xlab-2"",ylabz"Distance",main-"Clustering for NASA Understory Data") 





结果 如 下 : 
NASA 林 下 植被 数据 聚 类 结果 
60 
κε 
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0 
ααπΏσβααρβεβᾶβασᾶσας ἂδς τα βᾷ E ET ETE ET EE EET ETE EET: 8 BB 
FEFEEEEKEEEFEEEE 555225 ECEEEEE ΠΗΠΠΩ ΠΕ ΡΡΕΟΡΡΕΡΣ == 三 三 5 


hclust (*, "ward.D") 


rect.hclust () HASERRE REA ΓΕΑ BAAR SE XJ By, ΘΕΟ ΕΦ ΓΡ, LAENE 
AFERKA. 


clust1 作 为 一 个 对 象 传 入 函数 ， 同 时 传 入 的 还 有 需要 形成 的 禾 的 数量 。 


> rect.hclust(clust1,k-2) 


结果 如 下 : 


NASA 林 下 植被 数据 聚 类 结果 


60 





hclust (*, "ward.D") 
cuts () ΕΡΕ ΓΗΗΞΕΗΗ SUE Bt ASRAB REAA, 3x8, clustitg 4l E— XJ P NTAERZN , 
同时 传 入 期 望 的 艇 数量 。 


> cuts=cutree (clust1,k=2) 
> cuts 


结果 如 下 : 
Aspen spruce Aspen Aspen Aspen spruce Aspen Aspen spruce spruce spruce Aspen Asp 
en Aspen 
1 2 1 E. 1 2 1 1 2 2 2 1 
1 1 


Aspen Aspen Aspen Aspen Aspen Aspen Aspen Aspen Aspen Aspen Aspen Aspen Asp 
en Aspen 


1 1 1 1 1 1 1 1 1 1 1 1 
1 1 
Aspen Aspen Aspen Spruce Spruce Spruce Spruce Spruce Spruce Spruce Spruce Spruce Spru 
ce Spruce 
1 1 1 2 2 2 2 2 2 2 2 2 
2 2 
Spruce Spruce Spruce Spruce Spruce Spruce Spruce Spruce Spruce Spruce Spruce spruce Spru 
ce Spruce 
2 2 2 2 2 2 2 2 2 2 2 2 
2 2 
Spruce Spruce Aspen Spruce Aspen Aspen Aspen 
2 2 1 2 1 1 1 


第 6 步 : 改进 模型 
首先 需要 载 入 以 下 包 : 


> library(vegan) 


vegan 包 最 初 被 社会 学 和 植被 生态 学 家 广泛 使 用 。 它 包括 排序 方法 、 多 样 性 分 析 以 及 其 他 功能 。 其 中 一 些 流行 的 工具 包括 多 
样 性 分 析 、 物 种 丰富 度 模型 、 物 种 丰富 度 分 析 、 差 异 分析 等 。 

下 一 步 是 通过 使 用 jaccard 距 离 方法 训练 模型 来 改进 模型 。 第 一 步 是 使 用 vegdist () 阔 数 计算 距离 起 孟 。 该 阔 数 计算 成 对 元 
素 的 距离 ， 并 把 结果 仓储 在 一 个 新 的 数据 框 dist1 中 。jaccard 系 数 衡量 有 限 样 本 集 的 相似 性 ， 该 系数 通过 两 集合 的 交集 大 小 除 以 
两 集合 的 并 集 大 小 计算 得 来 。 


> distl «- vegdist(NASA[,3:31], method-"jaccard", upper-T) 


一 步 是 使 用 Ward 方 法 进行 聚 类 。 使 用 hclust () BRŽU 


> clust1 <- hclust (distl,method-"ward.D") 
> clusti 


调用 clust1 显 示 了 使 用 的 聚集 方法 、 距 离 度量 方法 和 对 象 的 个 数 。 结 果 如 下 : 


call: 
hclust(d = dist1, method = "ward.D") 


Cluster method 
Distance 
Number of objects: 63 


plot () 函数 是 绘制 R 语 言 对 象 的 通用 函数 


> plot(clusti,labels- NASA[,2], cex=0.5, 
xlab="",ylab="Distance",main="Clustering for NASA Understory Data") 


clust1 数 据 框 作为 对 象 传 入 该 函数 。cex 给 出 了 缩放 数值 ， 通 过 该 值 可 以 把 文字 和 符号 相对 放大 到 默认 值 。 


结果 如 下 : 
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hclust (*, "ward.D") 


clust1 对 象 被 作为 ， 同 时 传 入 的 还 有 聚 类 的 数量 : 





> rect.hclust (clust1 ,k=2) 


结果 如 下 : 
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hclust (*, "ward.D") 


cuts () 函数 能 够 基于 期 望 的 组 数量 或 者 切割 的 高 度 将 树 切 割 到 不 同 的 组 : 


> cuts-cutree (clust1 ,k=2) 
> cuts 


M 
ΓΩ 
NH 
hu = 
NH 
MJ ΓΩ 
NH 
NH 
PJ MJ 
hn 
AJ MJ 
MJ H 
F = 
F = 
F = 


ο τα ας σα ο πιω τα κανα 
1 1 


使 用 判别 销 数 绘制 两 个 类 的 解 。 


clusplot () 函数 能 够 绘制 二 维 的 聚 类 图 。 这 里 ， 把 NASA 数 据 框 作为 对 象 传 入 。 


结果 如 下 : 


E) Plot Zoom 


绘制 NASA ŽERNE, Ward 方法 ， 两 个 最 重要 的 主 成 分 


成 分 1 





这 两 个 成 分 解释 了 47.81% 的 数据 差异 性 


使 用 判别 六 效 绘制 两 个 类 的 解 。 


为 了 区 分 给 定 的 类 别 ，plotcluster () 锐 数 使 用 映 尉 辫 数 进行 绘图 。 不 同 的 映射 方法 包括 经 典 判别 人 举 标 、 展 现 平 均值 和 协 万 
老 结 构 区 别 的 方法 、 非 对 称 方法 (从 混合 类 中 分 离 出 同 质 类 ) 、 本 地 基于 近邻 的 方法 和 基于 和 鲁 棒 协 方才 中 阵 的 方法 。 


clusplot () 函数 可 以 画 出 二 维 的 聚 类 图 。 这 里 把 NASA 的 数据 框 作为 对 象 传 入 : 


> clusplot(NASA, cuts, color-TRUE, shade-TRUE, labels-2, lines-0, 
main-"NASA Two Cluster Plot, Ward's Method, First two PC") 


结果 如 下 : 


DA 空间 中 的 两 个 族 的 聚 类 结 


ZB JR 


-Ί 


E, 





-10 -5 0 J 


接 下 来 ， 对 NAsAscale 数 据 框 用 t () 函数 进行 转换 : 


> library(fpc) 
> NASAtrans-t (NASAscale) 


是 使 用 闵可夫 斯 基 距 离 方 法 改进 模型 。 第 一 步 是 计算 距离 矩阵 。 这 里 使 用 dist () BEEN. 
闵可夫 斯 基 距 离 经 常 在 变量 为 比例 尺度 以 及 绝对 零 值 的 情况 下 使 用 。 


> dist1 <- dist(NASAtrans, method-"minkowski", p=3) 


一 步 是 使 用 Ward 方 法 进行 聚 类 。 使 用 hclust () 方法 。 


> clustl1 <- hclust (disti1,method-"ward.D") 
> clusti 


J&FBclustieSZi zn Y FARRA, PARED ANRIA, ART: 


call: 

hclust(d = disti, method = “ward. D™) 
cluster method : ward. D 

Distance : minkowski 


Number of objects: 29 


plot () 函数 是 绘制 R 对 象 的 通用 函数 。 这 里 ，plot () 函数 被 用 来 绘制 系统 树 图 : 


> plot(clusti,labels- NASA.1ab[1:29], cex-1, 
xlab-"",ylab-"Distance",main-"Clustering for NASA Understory Data") 


结果 如 下 : 
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hclust (*, "ward.D") 


切 ， 之 后 在 选 定 


BU 
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对 应 的 艇 。 系 统 树 图 首先 在 某 个 等 级 上 做 


ΤΕΕ 
mn 


权 干 绘制 矩形 以 强 


rect.hclust () 函数 会 围绕 系统 树 图 的 某 些 


的 核 干 上 绘制 长 方形 。 


类 的 个 数 : 


还 有 聚 


时 被 传 入 的 


n 
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> rect.hclust(clust1,kz3) 


结果 如 下 : 
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cutree(clusti1,k 


» cuts 
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结果 如 下 : 
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获取 全 基因 组 表达 数据 的 能 力 是 一 项 计算 复杂 度 非常 高 的 任务 。 由 于 人 脑 的 局 限 性 ， 是 无 法 解决 这 个 问题 。 但 是 ， 通 过 将 基 
因 分 类 进 数 量 较 少 的 类 别 后 再 进行 分 析 ， 就 能 将 基因 数据 加 工 到 更 易 理解 的 水 平 。 


聚 类 的 目标 是 将 一 组 基因 进行 划分 ， 使 相似 的 基因 党 入 同一 个 族 ， 同 时 不 相似 的 基因 落 入 不 同 的 族 。 这 里 需要 考虑 的 天 键 问 
题 是 如 何 定义 相似 性 ， 以 及 处 理 已 分 类 基因 。 这 里 我 们 使 用 两 种 基因 类 型 的 感光 性 来 探索 基因 聚 类 问题 。 


准备 工作 


为 了 进行 层次 聚 类 ， 我 们 使 用 从 实验 鼠 身 上 采集 的 数据 集 。 
第 1 步 : 收集 和 摘 述 数据 


该 任务 使 用 名 为 GS9E4051 data 和 GSE4051 design 的 数据 集 。 设 数据 集 以 标准 格式 存储 在 名 为 GS9E4051 data.csv 和 
GSE4051 design.csv 的 CSV 格 式 的 文件 中 。 


GSE4051_data 数 据 集 包 仿 29949 行 数据 和 39 个 变量 。 数 值 型 变量 如 下 : 
Sample_21 
: Sample 22 
: Sample 23 
: Sample 16 
: Sample 17 
: Sample 6 
: Sample 24 
: Sample 25 
: Sample 26 
: Sample 27 
: Sample 14 
: Sample 3 
: Sample 5 
: Sample 8 


: Sample 28 


: Sample 29 


- Sample, 30 


: Sample 31 


: Sample 1 


: Sample 10 


: Sample 4 


: Sample 7 


: Sample 32 


- Sample, 33 


- Sample, 34 


: Sample 35 


: Sample 13 


- Sample, 15 


: Sample 18 


: Sample 19 


- Sample, 36 


: Sample 37 


- Sample, 38 


- Sample, 39 


: Sample 11 


: Sample 12 


: Sample 2 


: Sample 9 


GSE4051_design 数 据 集 包含 39 行 数据 和 4 个 


: sidNum 


非 数 值 


Iar BA. 
型 变量 是 : 


SidChat 


=== 
AZ EB. 


数值 型 变量 


ΕΗ . 
XE: 


* devStage 


: glype 


以 下 为 实现 细节 。 

第 2 步 : 探索 数据 

版 本 信息 : 本 节 的 代码 在 R 3.2.3 版 本 中 测试 (2015-12-10) 。 

RColorBrewer 包 是 一 个 R 包 ,可 从 http://colorbrewer2.org 获 取 ， 它 提供 地 图 和 其 他 图 形 的 彩色 模板 。 


pvclust 包 用 来 实现 非 确定 性 的 层次 聚 类 分 析 。 在 层次 聚 类 中 ， 每 个 复 通 过 多 尺度 有 放 回 抽样 计算 p 值 。 一 个 禾 的 p 值 在 0~ 1 
之 间 。p 值 有 两 种 类 型 : 近似 无 俩 (approximately unbiased, AU) 和 有 放 回 概率 (bootstrap probability, BP) 值 。AU p 
值 通过 多 尺度 有 放 回 采样 方法 计算 ， 经典 的 有 放 回 采样 方法 用 来 计算 BP p 值 。AU p 值 相 比 BP p 值 存在 优 效 性 偏见 。 


xtable 包 可 以 生成 LaTeX 格 式 的 表格 。 使 用 xtable 可 以 将 特定 的 R 对 象 转换 成 xtables。 这 些 xtables 能 够 以 LaTeX 或 HTML 的 
格式 输出 。 


plyr 包 被 用 来 进行 分 置 合并 (split-apply-combine, SAC) 过 程 。 它 将 一 个 大 的 问题 切 分 成 易 处 理 的 小 块 ， 在 每 个 小 块 上 
进行 操作 ， 然 后 将 所 有 小 块 合并 起 来 。 


载 入 以 下 包 : 


library (RColorBrewer) 
library (cluster) 
library (pvclust) 
library (xtable) 
library (plyr) 


V V V V V 


让 我 们 探索 并 理解 变量 间 的 关系 。 从 导入 名 为 GSE4051 data.csv 的 CSV 文 件 开始 。 我 们 将 该 文件 数据 存储 到 GSE4051 data 
数据 框 中 : 


> GSE4051 data -read.csv("d:/ GSE4051 data.csv",header-T) 


接 下 来 ， 输 出 GSE4051_data 数 据 框 的 信息 。str O 函数 返回 GSE4051_data 的 结构 信息 。 它 简略 显示 了 GSE4051_data 数 
据 框 的 内 部 结构 。maxleve| 指 明了 为 了 显示 网 状 结构 的 最 大 等 级 。 


> str(GSE4051 data, max.level = 0) 
结果 如 下 : 
"'"data.frame': 29949 obs. of 39 variables: 


下 面 ,我 们 导入 名 为 GSE4051_design.csv 的 CSV 文 件 ， 将 其 数据 保存 到 GSE4051_design 数 据 框 中 : 


> GSE4051 design -read.csv("d:/ GSE4051 design.csv",header-T) 


上 面 一 行 输出 了 GSE4051 design 数 据 框 的 内 部 结构 。 


结果 如 下 : 
"'data.frame': 39 obs. of 4 variables: 
$ sidchar : Factor w/ 39 levels "sample 1","sample 10",..: 13 14 15 16 8 9 36 17 18 19 ... 
$ sidNum ; int 20 21 22 23 16 17 6 24 25 26 ... 
$ devstage: Factor w/ 5 levels "4 weeks","E16",..: 2 2 2 2 2 2 2 4 4 4 ... 


$ gType : Factor w/ 2 levels "NrlKO”,”"%t” 2222111222... 


第 3 步 : 转换 数据 


为 了 便于 后 续 的 可 视 化 阶段 ， 需 要 对 每 一 行 数 据 进 行 拉 伸 操作 。 这 是 由 于 人 在 目前 的 要 求 下 ， 不 同 基 因 表 达 之 间 仓 在 绝对 值 的 
差距 ， 因 此 需要 对 每 一 行 数 据 进行 拉 伸 。 


中 心 化 变量 和 创建 z 值 是 两 个 常见 的 数据 分 析 方 法 。scale 国 数 中 心 化 并 拉 伸 数值 型 矩阵 的 列 。 
变换 矩阵 。 传 入 GSE4051 data 数 据 框 来 进行 数据 框 变换 。 


> trans, GSE4051 data <- t (scale (t (GSE4051_data))) 


接 下 来 ， 我 们 输出 GSE4051_data 数 据 框 的 信息 。 通 过 设置 give.attr=FALSE， 次 级 结构 的 属性 不 会 被 显示 。 


> str(trans GSE4051 data, max.level = 0, give.attr = FALSE) 


结果 如 下 : 


num [1:29949, 1:39] 0.0838 0.1758 0.7797 -0.3196 0.8358 ... 


head () BgZjiRIBI—[)8&. BE, zx. SAGRSIEBKBREXHUSCHB. GSEA4051 datafltrans GSE4051 dataZiiless ATEXIS 
I&A. rowMeans () 函数 计算 每 列 的 平均 值 。data.frame () ΜΕΡΗ OSEE SEG, MEHRA AIEA : 


> round(data.frame(avgBefore = rowMeans (head (GSE4051 data)), 
avgAfter = rowMeans (head (trans GSE4051 data)), 
varBefore = apply(head(GSE4051 data), 1, var), 
varAfter - apply(head(trans GSE4051 data), 
1, var)), 2) 


结果 如 下 : 

avgBefore avgAfter varBefore varAfter 
1 /. 22 0 0.02 1 
2 9.37 0 0.35 1 
3 9.70 0 0.15 1 
4 8.42 0 0.03 1 
5 8.47 0 0.02 1 
6 9.67 0 0.03 1 


第 4 步 : 训练 模型 


接 下 来 是 训练 模型 。 第 一 步 是 计算 距离 矩阵 。dist O 函数 用 来 计算 并 返回 距离 矩阵 ， 可 以 使 用 特定 的 距离 度量 方法 来 计算 


AGEE AITEAS. ixEBHIfBFHRUEBESEISIGIATSBRAXUBES. RAPA, SIKIERA, HAMBA., ΙΕΡΗ, ἘΚ ΤΙ 
夫 斯 基 距 离 。 这 里 使 用 欧式 距离 。 欧 式 距离 计算 两 个 向 量 间 的 距离 公式 为 sqrt (sum ( (x i-y 1) ^2) ) 。 转 换 后 的 
trans GSE4051 data 数 据 框 被 用 来 计算 距离 。 结 果 人 存储 在 pair dist GSE4051 data 数 据 框 中 。 


> pair dist GSE4051 data <- dist(t(trans GSE4051 data), method = 
'euclidean') 


接 下 来 ， 使 用 interaction () 函数 计算 并 返回 gType、devStage 变 量 间 相 互 作用 的 无 序 因子 。 无 序 因 子 的 结果 连同 
G9SE4051_design 数 据 框 一 同 被 传 入 with () 函数 。 访 国 数 计算 产生 一 个 新 的 因子 代表 gType、devstage 变 量 的 相互 作用 : 


> GSE4051 design$group <- with(GSE4051 design, interaction (gType, 
devStage)) 


summary () 函数 用 来 生成 GSE4051 design$group 数 据 框 的 结果 总 结 : 


IONA e 


> summary (GSE4051_design$group) 


结果 如 下 : 


Nr ]K0.4_weeks wt.4 weeks Nr IKO. E16 wt. E16 Nr IKO. P10 wt. P10 Nr IKO. P2 wt. P2 Nr IKO. PG 
4 4 3 4 4 


wt. PG 
4 


下 面 ， 使 用 多 种 不 同 的 联合 类 型 计算 层次 聚 类 。 


使 用 hclust () 阔 数 对 n 个 不 同 对 象 进行 聚 类 分 析 。 第 一 个 阶段 ， 每 个 对 象 补 指派 给 目 己 的 艇 。 算 法 在 每 个 阶段 迭代 聚合 
个 最 相似 的 簇 。 持 续 该 过 程 直到 只 剩 一 个 单独 的 簇 。hclust () 函数 要 求 我 们 以 距离 和 矩阵 的 形式 提供 数据 。 
pair dist GSE4051 data 数 据 框 被 传 入 。 


在 第 一 个 例子 中 使 用 single 聚 类 方法 : 


> pr.hc.single <- hclust(pair dist GSE4051 data, method = 'single') 


prhc.single 的 调用 结果 是 现实 使 用 的 聚集 方法 、 距 离 计 算 方 法 和 对 象 效 量 : 


> pr.hc.single 


结果 如 下 : 


call: 
hclust(d = pair_dist_GsE4051_data, method = "single") 
Cluster method : single 


Distance : euclidean 
Number of objects: 39 


在 第 二 个 例子 中 使 用 complete 聚 集 方 法 。 


> pr.hc.complete <- hclust(pair dist GSE4051 data, method = 'complete') 


调用 prhc.complete 的 结果 是 显示 所 使 用 的 聚集 方法 、 距 离 计算 方法 和 对 象 数量 : 


> pr.hc.complete 


结果 如 下 : 


Call: 
hclust(d = pair dist GSE4051 data, method = "complete") 


Cluster method : complete 
Distance : euclidean 
Number of objects: 39 


在 第 三 个 例子 中 使 用 average 聚 类 方法 : 
> pr.hc.average <- hclust(pair dist GSE4051 data, method = 'average') 


调用 prhc.complete 的 结果 是 显示 所 使 用 的 聚集 方法 、 距 离 计算 方法 和 对 象 数量 


> pr.hc.average 


结果 如 下 : 


Call: 
hclust(d = pair dist GSE4051 data, method = "average") 


Cluster method : average 
Distance : euclidean 
Number of objects: 39 


在 第 四 个 例子 中 使 用 ward 聚 类 方法 : 
> pr.hc.ward <- hclust(pair dist GSE4051 data, method = 'ward.D2"') 


prhc.ward 的 调用 结果 是 显示 所 使 用 的 聚集 方法 、 距 离 计 算 万 法 和 对 象 数量 : 


> pr.hc.ward 


结果 如 下 : 


Call: 
hclust(d = pair dist GSE4051 data, method = "ward.D2") 


Cluster method * ward. 02 
Distance : euclidean 
Number of objects: 39 


> op <- par(mar = c(0,4,4,2), mfrow = c(2,2)) 
plot () 函数 是 绘制 R 对 象 的 通用 函数 。 


第 一 次 调用 plot () 函数 ， 传 递 pr.hc.single 数 据 框 作为 输入 对 象 


> plot(pr.hc.single, labels = FALSE, main = "Single Linkage 


Representation", xlab - "") 
结果 如 下 : 
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第 二 次 调用 plot () 函数 ， 传 入 pr.hc.complete 数 据 框 作 为 输入 对 象 : 


> plot(pr.hc.complete, labels = FALSE, main = "Complete Linkage 
Representation", xlab - "") 
结果 如 下 : 
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三 次 调用 plot () 函数 ， 传 入 pr.hc.average 数 据 框 作为 输入 对 象 : 


> plot(pr.hc.average, labels = FALSE, main = "Average Linkage 
Representation", xlab - "") 


结果 如 下 : 
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第 四 次 调用 plot () 水 数 ， 传 入 pr.hc.ward 数 据 框 作为 输入 对 象 : 


> plot (pr.hc.ward, labels = FALSE, main = "Ward Linkage 
Representation", xlab = "") 
结果 如 下 : 


ward 聚 类 结果 


100 200 300 400 500 600 700 


inl 
quini 
(> 
> par (op) 


> op «- par(mar = c(1,4,4,1)) 


第 5 步 : 绘制 模型 


plot () 上 函数 是 绘制 R 对 象 的 通用 函数 。 这 里 ，plot () 函数 用 来 绘制 系统 树 图 。 


rect.hclust () 水 数 强 调 不 同 的 艇 ， 并 在 系统 树 图 的 校 干 上 绘制 长 方形 。 系 统 树 图 首先 在 某 个 等 级 上 被 剪 切 ， 之 后 在 选 定 的 
权 干 上 绘制 长 万 形 。 


RColorBrewer 使 用 从 http://colorbrewer2.org 获 得 的 包 来 选择 绘制 R 图 像 的 颜色 模板 。 


顷 色 分 为 三 组 : 


S 


深 色 。 








. 时 序 : 低 数 据 浅 色 ; 高 数据 





` 分 歧 : 中 间 数 据 浅 色 ; 低 和 高 范围 数据 一 一 相反 的 深 色 。 
定性 的 : 设计 顾 色 以 强调 不 同 悉 之 间 的 最 大 视觉 差 。 


最 重要 的 一 个 RColorBrewer 了 消 数 是 brewer.pal () 。 通 过 向 该 亢 数 传 入 颜色 的 数量 和 配色 的 名 字 ， 可 以 从 
display.brewer.all () 函数 中 选择 一 个 配色 方案 。 


在 第 一 个 例子 中 ，pr.hc.single 作 为 一 个 对 象 传 入 plot () RŽ 


> plot(pr.hc.single, labels = GSE4051 design$group, cex = 0.6, main = 
"Single Hierarchical Cluster - 10 clusters") 
> rect.hclust (clust1l1,k-5) 





结果 如 下 : 
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下 面 创建 热度 图 ， 使 用 single 聚 集 方法 。heatmap () 遂 数 默认 使 用 euclidean 聚 集 方法 : 


> par (op) 
> jGraysFun <- colorRampPalette (brewer.pal(n = 9, 
> gTypeCols «- brewer.pal(9, "Spectral")[c(4,7)] 


> heatmap(as.matrix(trans GSE4051 data), Rowv = NA, col 
jGraysFun(256), hclustfun - function(x) hclust(x, method - 


"Blues")) 


'single'), 


scale - "none", labCol - GSE4051 design$group, labRow - NA, margins - 


c(8,1), 


ColSideColor - gTypeCols[unclass (GSE4051 design$gType)]) 
> legend("topright", legend = levels(GSE4051 design$gType), col = 


gTypeCols, lty = 1, lwd = 5, cex = 0.5) 


结果 如 下 : 
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在 第 二 例子 中 ，pr.hc.complete 作 为 对 象 传 入 plot () BREX: 


> plot(pr.hc.complete, labels = GSE4051 design$group, 
"Complete Hierarchical Cluster - 10 clusters") 
» rect.hclust(pr.hc.complete, k - 10) 
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6, main - 


结果 如 下 : 
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下 面 使 用 complete 聚 集 方法 创建 热度 图 : 


> par(op) 
> jGraysFun <- colorRampPalette (brewer.pal(n = 9, "Greens")) 
> gTypeCols «- brewer.pal(11, "PRGn")[c(4,7)] 


» heatmap(as.matrix(trans GSE4051 data), Rowv - NA, col - 
jGraysFun(256), hclustfun = function(x) hclust(x, method = 'complete'), 
scale = "none", labCol = GSE4051 design$group, labRow = NA, margins = 
c(8,1), 


ColSideColor = gTypeCols[unclass (GSE4051 design$gType)]) 
> legend("topright", legend = levels(GSE4051 design$gType), col = 
gTypeCols, lty = 1, lwd = 5, cex = 0.5) 


结果 如 下 : 


wt.P6 
wt.P10 





| 
| I 


ii 


ΝτΙΚΟ 


|] 


| 


nm 


| 
| 


| 


. ΠΗ 
a ΠῚ 
| 
| 





Cd'OXUN 
Cd' OAHN 
ζ4 OAHN 
¿di 
zd'in 

syaani p OHUN 
Ε΄ ή! 
¿di 

Ohd ii 

gd' ii 

913 OXUN 
Cd'OXVN 
9d' OXUN 
Πα hi 

Dbd’ 10 
ΒΗΒΒΗΡ μὴ 
Π|4᾿ μή 
gd 

πιά OXEN 
913 in 

913 OXUN 
313' OXUN 
[ιά OXEN 
πιά OXEUN 
ÜLd' OXEN 
SWaam p μή 


| ΒΗΘΘΗΓ ΗΝ 
| ΒΗΒΘΗ 4 的 


sxaam p' OWN 
ayaan p QHN 
943 1m 

syaam ΩΜΗ 
943 1^ 

9434 

ζα 4 的 

9d ή 

9d OAHN 

gd' OAMHN 

gd' OAHN 


个 例子 中 ，pr.hc.average 作 为 对 象 传 入 plot () 函数 : 


在 第 三 


gn$group, cex = 0.6, main = 


GSE4051 desi 


labels - 
"Average Hierarchical Cluster - 10 clusters") 


> plot(pr.hc.average, 


k - 10) 


> rect.hclust(pr.hc.average, 


结果 如 下 : 
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下 面 创建 average 聚 集 方 法 的 热度 图 |: 
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NIlKO.P 10 


> jGraysFun <- colorRampPalette(brewer.pal(n = 9, "Oranges")) 


> gTypeCols «- brewer 


.pal(9, "Oranges")[c(4,7)] 


> heatmap(as.matrix(trans GSE4051 data), Rowv = NA, col = 


jGraysFun (256), hclustfun 


c(8,1), 

ColSideColor = gTypeCols 
» legend("topright", 

gTypeCols, lty = 1, lwd = 


结果 如 下 : 


= function(x) hclust(x, method = 'average'), 
scale = "none", labCol = GSE4051 design$group, labRow = NA, margins 


[unclass (GSE4051 design$gType)]) 
legend = levels(GSE4051 design$gType), 
5, σεχ = 0.5) 
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在 第 四 个 例子 中 ，pr.hc.ward 作 为 对 象 传 入 plot () ΜΕ: 


gn$group, cex = 0.6, main = 


GSE4051 desi 


labels - 


"Ward Hierarchical Cluster - 10 clusters") 


» plot(pr.hc.ward, 


κ = 10) 


, 


> rect.hclust(pr.hc.ward 


结果 如 下 : 
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下 面 绘制 ward 聚 集 方法 的 热度 图 : 


> jGraysFun <- colorRampPalette (brewer.pal(n = 9, "Reds")) 

> gTypeCols «- brewer.pal(9, "Reds")[c(4,7)] 

> heatmap(as.matrix(trans GSE4051 data), Rowv = NA, col = 
jGraysFun(256), hclustfun = function(x) hclust(x, method = 'ward.D2'), 

scale = "none", labCol = GSE4051 design$group, labRow = NA, margins = 
c(8,1), 

ColSideColor = gTypeCols[unclass(GSE4051 design$gType)]) 

> legend("topright", legend = levels(GSE4051 design$gType), col = 
gTypeCols, lty = 1, lwd = 5, cex = 0.5) 


结果 如 下 : 
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35 二进制 聚 关 : 数学 测验 


在 教育 体系 中 ， 测 验 和 考试 非常 重要 。 考 试 系统 的 优势 在 于 它 是 区 分 学 生 表 现 优秀 与 欠 佳 的 有 效 途 径 之 一 。 考 试 系统 的 目的 
是 衡量 学 生 是 否 具 有 升 入 下 一 个 水 平 阶段 的 能 力 。 它 负责 让 不 同 的 学 生 在 不 同 的 与 之 相 适 应 的 水 平 阶段 学 习 。 考 试 系统 同样 使 学 
生 做 好 面 对 未 来 挑战 的 准备 。 它 帮助 学 生 们 分 析 原 因 ， 并 让 他 们 彼此 之 间 以 一 个 固定 的 频率 有 效 的 交流 想法 。 另 一 万 面 来 说 ， 考 
试制 度 也 有 缺 操 ， 比 如 学 习 速 度 慢 的 学 生 不 能 在 测验 中 有 好 的 表现 ， 这 可 能 会 让 他 们 产生 目 摆 情绪 。 


准备 工作 
为 了 执行 二 进 制 取 类， 我们 使 用 在 数学 测验 中 收集 的 数据 集 。 
第 1 步 : 收集 和 接 述 数据 


该 任务 使 用 名 为 math test 的 数据 集 。 访 数据 集 以 标准 格式 存储 在 TXT 格 式 的 文件 中 。 其 中 包含 60 行 数据 ，60 列 。 每 列 的 内 


容 是 55 位 男 同学 的 分 数 项 目 。 


具体 实施 步骤 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 
版 本 信息 : 本 节 的 代码 在 R 3.2.3 版 本 中 测试 (2015-12-10) 


让 我 们 探索 数据 并 理解 变量 间 的 关系 。 从 导入 名 为 ACT math test.txt 的 TXT 文 件 开 始 。 我 们 把 数据 保存 在 Mathtest 数 据 框 


> Mathtest = read.table("d:/math test.txt",header-T) 


第 3 步 : 训练 





喘 型 指标 
接 下 来 ， 我 们 开始 聚 类 过 程 。 基 于 学 生得 分 构建 的 项 目 组 被 一 起 执行 聚集 操作 。 
首先 ， 我 们 应 该 基于 平方 欧式 距离 统计 整体 的 错 酝 


调用 dist () 函数 。Mathtest 数 据 框 被 传递 给 dist () 水 数 作为 输入 。 统 计 整 体 的 欧式 距离 平方 的 错 配 庚 ， 结 果 存 储 在 
dist.items 数 据 框 中 : 


> dist.items <- dist(Mathtest[,-1], method-'euclidean')^2 


接 下 来 ， 输 出 dist.items 数 据 框 。 


> dist.items 


结果 如 下 : 


1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 


32 26 30 25 24 27 27 32 18 25 18 19 26 21 23 22 31 20 24 25 22 20 24 25 24 25 24 23 23 20 20 22 

33 21 23 20 25 24 20 19 21 16 21 22 23 22 22 21 18 25 23 24 25 19 17 22 17 22 19 24 1823 21 23 21 

34 19 23 16 25 20 20 23 15 24 25 18 21 20 22 25 24 27 21 22 19 21 17 20 21 26 23 24 22 23 15 23 21 20 

35 21 25 18 17 20 22 21 17 20 19 20 21 20 16 17 24 23 21 24 25 21 23 20 17 24 21 18 20 21 21 21 21 22 24 

36 30 26 25 24 23 27 26 18 29 24 23 22 17 33 22 25 20 22 27 22 26 22 27 28 25 28 17 23 18 22 28 24 25 25 21 

37 26 30 19 20 23 23 24 16 19 20 19 24 21 23 24 31 22 18 19 22 18 20 19 24 19 24 17 17 20 20 28 18 21 23 19 20 
B 24 24 D : p D D D 16 D 18 ' : B 14 ή D 


接 下 来 ， 距 离 度量 忽略 0-0 匹 配 。dist () 函数 使 用 二 进 制 方法 。 在 二 进 制 方法 中 ， 非 零 元 素 打 开 ， 零 元 素 天 闭 ， 因 此 癌 量 


馈 当 作 二 进 制 比特 位 组 。 


> dist.items.2 <- dist (Mathtest[,-1], 


接 下 来 ， 我 们 输出 数据 框 distitems.2， 观 察 结果 。 


结果 如 下 : 


接 下 来 ， 距 离 度量 忽略 1-1 配 对 。dist () 函数 使 用 二 进 制 方法 。 在 二 进 制 方法 中 ， 非 零 元 素 打 开 ， 零 元 素 天 闭 ， 因 此 癌 量 
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0. 5714286 
0. 6078431 
0.4166667 
0. 5714286 
0. 3829787 
0.4509804 
0. 3846154 
0. 5686275 
0.4255319 
0. 6078431 
0. 5208333 
0. 5833333 
0. 5000000 
0.4583333 
0. 5416667 
0.4375000 
0. 3958333 
0.4285714 
0. 6000000 


2 


0. 3333333 
0.4230769 
0.1836735 
0.2549020 
0. 3200000 
0.4489796 
0. 3061224 
0.4800000 
0.4901961 
0. 3750000 
0. 3877551 
0. 3400000 
0.4400000 
0. 3125000 
0. 5306122 
0. 5416667 
0. 5510204 
0.4489796 
0. 5416667 
0. 3829787 
0. 3541667 
0. 3200000 
0. 5102041 
0.4255319 
0. 5510204 
0. 5208333 
0. 6666667 
0. 5000000 
0.4583333 
0. 6000000 
0.4693878 
0.4600000 
0.4901961 
0. 5416667 


tS STE BERAE. 


2 
3 
4 
5 
6 
7 
8 
9 


> dist.items.3 «- dist(1 - Mathtest[,-1], 


0. 3958333 
0. 2500000 
0. 2857143 
0. 3541667 
0. 3488372 
0. 3043478 
0. 5208333 
0. 3636364 
0.4468085 
0. 3181818 
0. 3404255 
0.4130435 
0.4489796 
0.4047619 
0.4883721 
0. 5000000 
0. 3863636 
0.4883721 
0.4222222 
0. 3181818 
0. 3541667 
0.4888889 
0.4666667 
0.4285714 
0. 3500000 
0. 5681818 
0.4772727 
0. 5000000 
0. 5555556 
0.4444444 
0. 3636364 
0.4000000 
0. 5555556 


0. 3800000 
0.4423077 
0. 3829787 
0.4888889 
0.4693878 
0.4545455 
0.4318182 
0. 5416667 
0. 3863636 
0.4375000 
0. 3333333 
0.4468085 
0.5777778 
0. 5238095 
0. 5348837 
0. 5531915 
0.4878049 
0.4888889 
0.4222222 
0. 3829787 
0. 5227273 
0. 5333333 
0.4250000 
0.4634146 
0. 5714286 
0. 5454545 
0. 5957447 
0. 5581395 
0. 5434783 
0. 5319149 
0. 3953488 
0. 5581395 


接 下 来 ， 我 们 输出 数据 框 dist.items.3， 观 察 结果 。 


结果 如 下 : 


1 
0.8888889 
0. 8095238 
0. 9629630 
0. 8947368 
0.7647059 
0. 7619048 
0. 6923077 
0. 8260870 


10 0.8275862 
11 0.8214286 


2 


0. 8095238 
0. 8800000 
0. 6000000 
0.7647059 
0.7619048 
0.7857143 
0. 7142857 
0.8275862 
0. 8620690 


0.7307692 
0. 6315789 
0. 7000000 
0.7083333 
0. 5555556 
0. 6086957 
0.7812500 
0. 5925926 


0. 7916667 


method-'binary') 


0. 3076923 
0.4038462 
0.4042553 
0.2916667 
0. 5000000 
0.4489796 
0. 3958333 
0. 3404255 
0. 3600000 
0. 3958333 
0.4000000 
0.4893617 
0. 5000000 
0.4782609 
0. 3695652 
0.4666667 
0.4375000 
0.4081633 
0. 3400000 
0.4680851 
0.4468085 
0.4782609 
0.4782609 
0. 6326531 
0. 5208333 
0.4791667 
0. 5625000 
0.4897959 
0.4166667 
0.4166667 
0. 5000000 


0.8846154 0.8421053 
0.6923077 0. 8750000 0.7142857 
0. 6875000 0.7037037 0.7037037 0.6666667 


0.7931034 0.6666667 0.5263158 0.6800000 ο. 6774194 
0.6451613 0.8333333 0.7931034 0.6666667 0.5882353 0.7187500 


0. 3061224 
0.4042553 
0. 2173913 
0.4693878 
0. 3111111 
0. 3260870 
0.4081633 
0. 3265306 
0.4285714 
0.4313725 
0. 5208333 
0. 5319149 
0. 5106383 
0. 5000000 
0. 6200000 
0. 3695652 
0. 3404255 
0. 3400000 
0. 5000000 
0.4791667 
0. 5416667 
0.4782609 
0. 5434783 
0.4222222 
0.4468085 
0. 5625000 
0.4255319 
0.4166667 
0.4489796 
0. 5625000 


ωωωωωωωωωωωωωωωωωωωωωωωωωώοο 


. 4444444 
. 3617021 
.4444444 
.4565217 
. 3636364 
.4468085 
. 3260870 
.4680851 
. 3333333 
. 6530612 
. 5454545 
.5555556 
. 5416667 
.5777778 
.4444444 
.4130435 
. 3404255 
. 5744681 
.4545455 
.5555556 
.4523810 
.6222222 
.4651163 
. 5217391 
. 6666667 
.4318182 
.4893617 
.4565217 
.5777778 


method-'binary') 
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0. 6333333 0.7857143 0.5833333 0./000000 0.5312500 Ο. 6666667 0.6571429 


ϱ. /692308 
ο. 8928571 
ο. 7727273 
0. 8148148 
ο. 9239239 
0. 8823529 
0. 8235294 
0. 8857143 
ο. 7407407 
0. 8235294 
0. 6923077 
0. 8518519 
0. 8695652 
0. 8787879 
0. 142857 
0. 8857143 
0. 7812500 
0. 8000000 
0. 7741935 
0.7586207 
0. 7878788 
0. 7500000 
ο. 7307692 
ο. 7777778 
0. 8571429 


0. 200000 
ο. 7600000 
ο. 7727273 
0. 8148148 
0. 6818182 
0. 8125000 
0. 7878788 
0. 8181818 
ο. 7857143 
0. 7878788 
0. 6923077 
0. 083333 
0.7619048 
0. 8064516 
0. 7142857 
0. 8181818 
0.7812500 
0. 8947368 
0.7741935 
0.7586207 
0.8571429 
0.7931034 
0. 8214286 
0. 8620690 
0.7878788 


0.7241379 
0. 5600000 
0. 6666667 
0. 6785714 
0. 7857143 
0. 5666667 
0. 6363636 
0. 6666667 
0. 6071429 
0. 6363636 
0. 6551724 
0. 5600000 
0. 7083333 
0. 687 5000 
0. 6774194 
0. 5806452 
0. 4827586 
0. 6944444 
0. 6562500 
0. 7187500 
0. 7142857 
0. 6666667 
0. 5925926 
0. 6428571 
0. 7142857 


0. 7878788 
0. 6071429 
ο. 7500000 
0. 5185185 
0. 7241379 
0.7222222 
0.6285714 
0. 6571429 
0.7647059 
0. 5882353 
0. 687/5000 
0. 6551724 
0. 6923077 
0.6764706 
0. 7058824 
0. 5312500 
0.5757576 
0. 6486486 
0. 6857143 
ο. 7777778 
0. 6666667 
0.7352941 
0.7575758 
0. 5862069 
0. 6666667 


0.7307692 
0. 6666667 
0.7826087 
0.7307692 
0. 8000000 
0. 7419355 
0.7187500 
0.7096774 
0. 6538462 
0.6//4194 
0. 7500000 
ο. 7692308 
ο. 7727273 
ο. 333333 
ο. 7241379 
ο. 2096/74 
0.7096774 
0.8378378 
0. 7812500 
ο. 7666667 
ο. 7941176 
0. 8000000 
0. 7407407 
0. 7407407 
0.7187500 


0. 6250000 
0.7692308 
0. 7272727 
0.7777778 
0. 8461538 
0.7812500 
0.7575758 
0. 7500000 
0. 8333333 
0. 8611111 
0. 6538462 
0. 6666667 
0.7727273 
0.7741935 
0. 7666667 
0.7878788 
0.7096774 
0.7352941 
0. 6551724 
0.7241379 
0.7941176 
0. 7142857 
0. 7407407 
0.7857143 
0.7941176 


0. 5925926 
0.7241379 
0. 6250000 
0.7333333 
0. 6000000 
0. 8421053 
0. 6857143 
0. 7142857 
0.7878/788 
0.7222222 
0. 6666667 
0. 6785714 
0. 6666667 
0.7714286 
0. 6451613 
0.7142857 
0. 5937500 
0.7368421 
0. 6250000 
0. 7272727 
0. 8205128 
0. 6333333 
0. 7419355 
ο. 7000000 
0.7222222 


0. 5161290 
0. 6363636 
0. 6333333 
0. 6060606 
0. 352941 
0. 5945946 
0. 5405405 
0. 5675676 
0. 5000000 
0. 5000000 
0. 5454545 
0. 5937500 
0.7096774 
0. 5833333 
0. 514286 
0. 5277778 
0.4857143 
0. 5263158 
0.4705882 
0. 5714286 
0. 5000000 
0. 6000000 
0.4838710 
0. 5312500 
0. 5000000 


0. 6551724 
0. 6896552 
0. 6923077 
0.7419355 
0. 7142857 
0. 6363636 
0.7297297 
0. 6470588 
ο. 7187500 
0. 6944444 
0.6/74194 
0. 6428571 
0. 6800000 
0. 6666667 
0. 6562500 
0. 5625000 
0. 5625000 
0.6756757 
0. 6363636 
0. 6969697 
0. 6944444 
0. 5517241 
0.7500000 
0. 6666667 
0.7631579 


0. 5625000 
0. 6363636 
0.7941176 
0. 5625000 
0. 6969697 
0. 7317073 
0. 6500000 
0. 5675676 
0.7368421 
0. 5789474 
0. 6285714 
0. 6363636 
0. 7878788 
0.4545455 
0.6111111 
0. 5675676 
0. 5675676 
0. 6666667 
0.6315789 


0.6153846 


下 一 步 使 用 complete 方 法 执行 聚 类 。 为 了 在 n 个 不 同 的 对 象 上 执行 聚 类 分 析 ， 需 要 使 用 hclust () 函数 。 第 一 个 阶段 ， 每 个 
对 象 家 指派 给 它 目 己 的 能。 算法 在 每 一 个 阶段 欠 代 执行 ， 将 两 个 相似 艇 合并。 该 过 程 持续 进行 直到 只 有 一 个 篮 为 止 。hclust () 
肖 数 要 求 我 们 以 距离 站 阵 的 形式 提供 数据 。dist1 数 据 框 被 作为 输入 数据 传 入 。 该 销 数 默认 使 用 全 链接 万 法 。 此 外 还 可 以 使 用 多 
种 聚 类 方法 ， 包 括 ward.D、ward.D2、single、complete 和 average。 


这 里 使 用 的 方法 是 complete。 调 用 该 方法 时 ， 形 成 的 簇 中 艇 内 对 和 象 和 艇 外 对 象 间 的 距离 最 大 。 


> items.complete.link «- hclust(dist.items, 
» items.complete.link 


method-'complete') 


调用 items.complete.link 函 数 可 以 显示 和 被 调用 的 聚 类 万 法 、 距 离 计 算 方 法 和 对 象 的 数量 。 结 果 如 下 : 
Call: 
hclust(d = dist.items, method = "complerte") 


Cluster method : complere 
Distance : euclidean 
Number of objects: 59 


第 4 步 : 绘制 模型 


plot () 水 数 是 绘制 R 对 象 的 通用 函数 。 这 里 ，plot O 义 数 用 来 绘制 全 链接 系统 树 图 。 


全 链接 用 于 层次 聚 类 ， 并 保证 两 个 艇 之 间 的 距离 最 大 。 在 使 用 全 链接 方法 时 ， 算 法 的 每 一 步 都 将 两 个 最 近 的 复合 并 起 来 。 该 
X ESI TAG EUSU RS F— 5: 


> plot(items.complete.link, labels-Mathtest[,1], ylab-"Distance") 


结果 如 下 : 


聚 类 系统 树 图 


17 
58 

20 

52 


dist items 
hclust (*, "complete") 


接 下 来 ,我们 在 系统 树 图 上 执行 单 链接 方法 。 在 单 链 接 层级 聚 类 的 每 一 步 迭 代 中 ， 对 象 被 分 给 两 个 驴 是 
对 象 的 最 小 聚 类 ， 或 者 说 是 久之 间 任 意 两 个 对 象 的 最 小 距离 。 


> items.sing.link <- hclust(dist.items, method-'single') 
> items.sing.link 


调用 items.sing.link 子 数 的 结果 是 显示 使 用 的 聚 类 方法 、 距 离 计算 万 法 和 对 和 象 的 数量 ， 结 果 如 下 : 


Call: 

hclust(d - dist.items, method - "single") 
Cluster method : single 

Distance : euclidean 


Number of objects: 59 


XE, plot () 消 数 用 来 绘制 全 连接 系统 树 图 ，items.sing.link 被 当 作 数据 框 传 入 : 


> plot(items.sing.link, labels-Mathtest[,1], ylab-"Distance") 


结果 如 下 : 


基于 艇 内 对 象 到 禾 外 


聚 类 系统 树 图 
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第 5 步 : K- DA (K-medoids) 聚 类 


载 入 cluster () FE: 
> library (cluster) 
7JIi EPA BESSER, η ΜΙΑ. 


Fe EBBA E APARER ARI  SKLERJJJ IA. JJ ΥΠΕΡ ΦΑΡΙΧΗΞΙΗΗ/Ν ΕΕ, ΤΕΛΗ ΓΕ κλπ. SCENDE 
fr-18127|H], 1 ΡΗΗΡΌΒΟΕΕ, -TXEZRXJARMICPUEBUSEBJUUEOIEEEZE. ΕΤΗ, MRAZ RRMA ΞΗΡΗ 


系数 ， 例 如 都 接近 1， 那 么 这 个 聚 类 结果 是 合适 的 。 
> my.k.choices «- 2:8 


reg () 是 一 个 通用 的 函数 用 来 复制 my.k.choices 的 值 。 结 果 保 存在 avg.sil.width 数 据 框 中 : 
> avg.sil.width <- rep(0, times-length (my.k.choices)) 


PAM 代 表 绕 中 心 点 分 割 法 (Partitioning Around Medoids) 。PAM 要 求 事先 知道 期 望 聚 类 的 数目 (例如 Kk 均值 聚 类 ) , 
但 为 了 保证 中 心 点 是 簇 内 对 象 的 真实 表示 ， 访 万 法 需要 比 k 均 值 聚 类 更 多 的 计算 量 。 


> for (ii in (1:length(my.k.choices)) )( 

+ avg.sil.width[ii] «- pam(dist.items, 
k-2my.k.choices[ii])$silinfo$avg.width 

Ἔ 


输出 choices 的 值 以 及 对 应 的 轮廓 系数 。 


> print( cbind(my.k.choices, avg.sil.width) ) 


结果 如 下 : 


my.k.choices avg.sil.width 


[1,] 2 0.15613282 
[2,] 3 0. 09740046 
[3,] 4 0. 08061349 
[4,] 3 0. 07817696 
[5,] 6 0. 07483902 
[6,] 7 0. 07018717 
[7,] 8 0.04567235 


在 两 个 复 的 基础 上 执行 聚 类 算法 : 


> items.kmed.2 «- pam(dist.items, k-2, diss-T) 
» items.kmed.2 


结果 如 下 : 


HL] 3 3 
[2,] 53 53 
clustering vector: 


[1]111111 1111211 11111221211122222222211221222222222222 
E 2 2 2 2 

[58] 2 2 

Objective function: 
build swap 

17.54237 16.98305 


Available components: 
[1] "medoids" “id. med” "clustering" "objective" "isolation" "clusinfo" “silinfo™ "diss 


[9] "call" 


lapply () BRSGRIBI—  XTBISHKISBUSEZE, RRA T 7USRSBEREXSXEPIBIV TUER DELAF UNBSEATS URS : 


> items.2.clust <- lapply(1:2, function(nc) 
Mathtest[,1][items.kmed.2$clustering--nc]) 
» items.2.clust 


结果 如 下 : 


LL1]] 

[1] 2 3 4 5 6 7 8 9 10 12 13 14 15 16 17 18 21 23 24 25 35 36 39 

[[2]] 

[1] 11 19 20 22 26 27 28 29 30 31 32 33 34 37 38 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 
58 59 60 


在 3 个 聚 类 的 基础 上 执行 聚 类 算法 。 


> items.kmed.3 «- pam(dist.items, k-3, diss-T) 
» items.kmed.3 


结果 如 下 : 


Clustering vector: 
11121121117271211717212222211122222212217322314132333323123 
3 3 3 2 3 3 2 
[58] 3 3 
Objective function: 
build swap 
15.81356 15.81356 


Available components : 
[1] "medoids" “id. med” "clustering" "objective" "isolation" "clusinfo”  “silinfo” "diss" 


[9] "call" 
» items.3.clust «- lapply(1:3, function(nc) 


Mathtest[,1][items.kmed.3$clustering--nc]) 
» items.3.clust 


结果 如 下 : 


[[1]] 
[1] 2 3 4 6 7 8 10 12 13 15 17 23 24 25 32 35 


[[2]] 
[1] 5 911 14 16 18 19 20 21 22 26 27 28 29 30 31 33 34 36 38 39 43 48 50 55 58 


[[3]] 
[1] 37 40 41 42 44 45 46 47 49 51 52 53 54 56 57 59 60 


A 


36 IG3(BERZS: BX 








eSESIRER IR ETRGER 


食品 消费 模式 是 医学 和 营养 学 领域 天 注 的 一 大 热点 。 食 物 消 费 与 个 人 的 整体 健康 、 食 物 的 营养 价值 、 购 买 食品 的 经 济 性 和 消 
费 环境 有 关 。 这 项 分 析 涉 及 25 个 欧洲 国家 肉 类 和 其 他 食品 之 间 的 关系 。 观 察 肉 类 和 其 他 食品 的 相关 性 是 很 有 意思 的 。 这 些 数据 
包括 : 红 肉 、 日 肉 、 量 类、 牛奶 、 鱼 类 、 谷 类 、 泥 粉 类 食品 、 坚 果 (包括 豆 类 和 油 籽 ) 、 水 果 和 蔬 荣 。 


准备 工作 


为 了 应 用 k 均 信 聚 类 ， 我 们 使 用 欧洲 25 个 国家 的 蛋白 质 消费 量 数据 集 。 

第 1 步 : 收集 和 描述 数据 

该 任务 使 用 名 为 protein 的 数据 集 ， 该 数据 集 以 标准 格式 存储 在 CSV 格 式 的 文件 中 ， 其 中 包含 25 行 数据 和 10 个 变量 。 
数值 型 变量 如 下 : 

: RedMeat 

: WhiteMeat 

T 


: Milk 


: Fish 
: Cereals 
: Starch 
: Nuts 
: Fr&Veg 
非 效 全 型 变量 如 下 : 


” Country 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 
版 本 信息 : 本 节 的 代码 在 R 3.2.3 中 测试 (2015-12-10) o 


让 我 们 探索 数据 并 理解 变量 间 的 关系 。 从 导入 名 为 protein.csv 的 CSV 文 件 开始 ， 将 该 数据 保存 到 protein 数 据 框 : 


> protein = read.csv("d:/Europenaprotein.csv",header-T) 


head () 阔 数 返回 了 一 个 向量 、 算 阵 、 表 、 数 据 框 或 函数 首 或 尾 的 部 分 。 将 protein 数 据 框 传 入 head () ΜΜ. 


> head(protein) 


结果 如 下 : 


Country RedMeat whiteMeat Eggs Milk Fish cereals Starch Nuts Fr-Veg 


1 Albania 10.1 1.4 0.5 8.9 0.2 42.3 0.6 $5.5 1.7 
2 Austria 8.9 14.0 4.3 19.9 2.1 28.0 3.6 1.3 4.3 
3 Belgium 131.5 9.3 4.1 17.5 4.5 26.6 3 2.1 4.0 
4 Bulgaria 7.8 6.0 1.6 8.3 1.2 56.7 ER da 4.2 
5 Czechoslovakia 9.7 11.4 2.8 12.5 2.0 34.3 5.0 1.1 4.0 
6 Denmark 10.6 10.8 3.7 25.0 9.9 21.9 4.8 00.7 2.4 


AE. δι 
第 3 步 : RX 


开始 在 三 个 篮 的 基础 上 进行 聚 类 。 为 了 在 初始 阶段 产生 随机 的 艇 数量， 调用 set.seed () 函数 。set.seed () 函数 能 够 产生 
随机 数 。 


> set.seed(123456789) 


kmeans () 函数 能 够 在 数据 矩阵 上 执行 k 均 值 聚 类 。protein 数 据 矩阵 被 当 作 一 个 对 象 传 入 该 函数 ， 该 对 象 必须 是 数值 型 矩 
WE, centers = 3 代表 初始 化 艇 中 心 数量 。 因 为 禾 的 数量 由 一 个 数字 指定 ，nstart = 10 定 义 了 随机 被 选择 的 中 心 数 。 


> groupMeat <- kmeans (protein[,c("WhiteMeat","RedMeat")], centers-3, 
nstart-10) 
> groupMeat 


结果 如 下 : 


K-means clustering with 3 clusters of sizes 8, 12, 5 
Cluster means: 
whiteMeat RedMeat 
1 12.062500 8.837500 
2 4.658333 8.258333 
3 9.000000 15.180000 


Clustering vector: 
[1] 2132111123 32132121222233212 


within cluster sum of squares by cluster: 
[1] 39.45750 69.85833 35.66800 
(between 55 / total_ss = 75.7 X) 


Available components: 
[1] "cluster" "centers" "totss" "withinss" "rot.withinss" "betweens 


5 
[7] "size" "iter" "difault" 


接 下 来 ， 生 成 簇 指派 列表 。order () BEEMGE[BI— FRAU, LAFEFESVE EEFRESWIAERKEBJ8S— Επ. groupMeatUEss 
当 作 一 个 数据 框 对 象 传 入 : 


> o=order (groupMeat$cluster) 


调用 data.frame () 函数 ， 显 示 了 国家 和 这 些 国家 所 处 的 簇 : 


> data.frame(protein$Country[o],groupMeat$cluster[o]) 


结果 如 下 : 


protein.Country.o. groupMeat.cluster.o. 


1 Austria 1 
2 Czechoslovakia 1 
3 Denmark 1 
4 E Germarny 1 
了 Hungary 1 
6 Nether lands 1 
7 Poland 1 
8 w Germany 1 
9 Albania 2 
10 Bulgaria 2 
11 Finland 2 
12 Greece 2 
13 Italy 2 
14 Norway 2 
15 Portugal 2 
16 Romania 2 
17 Spain 2 
18 Sweden 2 
19 USSR 2 
20 Yugoslavia 2 
21 Belgium 3 
22 France 3 
23 Ireland 3 
24 Switzerland 3 
25 UK 3 


plot () BRjZizR— MRAR RANEA. SAKT ERER., xlimZXBEXIESXUNIAUBXEIBE 
的 边界 ， 而 不 是 一 个 范围 。xlab 和 ylab 提 供 了 x 轴 和 y 轴 各 自 的 标题 : 
> plot(protein$Red, protein$White, type-"n", xlim-c(3,19), xlab-"Red 
Meat", ylab-"White Meat") 


> text(x-protein$Red, y-protein$White, 
labels-protein$Country,colzgroupMeat$cluster-*1) 


结果 如 下 : 


France 


oweden 
Homarfailgari 
Yugoslavia i | UK 





接 下 来 ， 在 所 有 9 个 备 晶 质 组 上 进行 聚 类 ， 并 且 7 个 艇 已 经 被 创建 了 。 在 散 点 图 上 不 同 颜 色 的 点 代表 了 吃 日 肉 和 红 肉 的 国 
家 。 地 理 上 临近 的 国家 倾向 于 分 到 同一 组 。 


set.seed () 国 数 产生 随机 数 : 


> set.seed(123456789) 


center = 7 代表 初始 的 聚 类 中 心 数量 : 


> groupProtein «- kmeans(protein[,-1], centers-7, nstart-10) 
> o-order (groupProtein$cluster) 
> data.frame(protein$Country[o],groupProtein$cluster[o]) 


7 个 不 同 的 聚 类 形成 了 。25 个 国家 都 一 一 被 分 配 到 了 某 一 个 簇 中 。 


结果 如 下 : 


protein.Country.o. groupProtein.cluster.o. 


1 Austria 1 
2 E Germany 1 
3 Netherlands 1 
4 w Germany 1 
5 Portugal 2 
6 spain 2 
7 Albania 3 
8 Greece 3 
9 Italy 3 
10 USSR 3 
11 Czechoslovakia 4 
12 Hungary 4 
13 Poland 4 
14 Bulgaria 5 
15 Romani a 5 
16 Yugoslavia 5 
17 Denmark 6 
18 Finland 6 
19 Norway 6 
20 Sweden 6 
21 Belgium 7 
22 France 7 
23 Ireland 7 
24 Switzerland 7 
25 UK 7 


> library (cluster) 
clustplot () 函数 创造 了 一 个 二 变量 的 图 ， 其 中 可 以 看 到 数据 的 可 视 化 划分 。 所 有 观测 值 使 用 主 成 分 以 点 的 方式 表示 。 在 
每 个 艇 周围 绘制 椭圆 形 。protein 数 据 框 被 当 作 对 象 传 入 : 


> clusplot(protein[,-1], groupProtein$cluster, main='2D representation 
of the Cluster solution', color-TRUE, shade-TRUE, labels-2, lines-0) 


结果 如 下 : 
聚 类 结 末 的 二 维 表 示 
CN 
C 
C 
RA 
=: 





ας -2 -Ί Ü 1 2 3 4 
成 分 1 
这 两 个 成 分 解释 了 62.68% 的 数据 差异 性 


另 一 个 层次 化 形式 展现 的 方法 如 下 。 这 里 使 用 agnes () 函数 。 通 过 设置 diss = FALSE， 不 相似 度 和 矩阵 被 用 来 计算 原始 数 
据 。metric= "euclidean "表明 使 用 欧 氏 距离 进行 计算 : 


> foodagg-agnes (protein,diss-FALSE,metric-"euclidean") 
» foodagg 


结果 如 下 : 


Call: agnes(x = protein, diss = FALSE, metric = "euclidian") 
Agglomerative coefficient:  0.6448106 
order of objects: 
[1] 1 4182523 2 3 5 71013161117 19 61214 91520212224 8 
Height (summary): 
Min. 1st Qu. Median Mean 3rd Qu. Max. 
/.115 9.631 11.710 13.380 16.250 29.130 


Available components: 
[1] "order" "height" "ac" "merge" "diss" "call" "method" "data" 


> plot(foodagg, main-'Dendrogram') 


结果 如 下 : 





Ας ης ZR AX = 0.64 
cutree () ERZXUJEUPURUJLT *Brh, AEAEE A V)SURUIESISCEXEHTXIS : 
> groups <- cutree(foodagg, k-4) 


结果 如 下 : 


系统 树 图 
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聚集 系数 = 0.64 


> rect.hclust(foodagg, k=4, border="red") 


结果 如 下 : 


系统 树 图 
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集 日 质 
聚集 系数 = 0.64 


3.7 均值 聚 类 : 食品 


我 们 所 吃 的 食物 中 的 营养 成 分 可 以 根据 它们 在 构建 身体 构成 的 作用 来 分 类 。 这 些 营养 元 素 可 分 为 宇 量 营养 元 素 和 微量 元 素 。 
一 些 大 量 营 养 元 素 包括 碳水 化 合 物 、 和 蛋 日 质 、 脂 肪 ， 一 些微 量 元 素 的 例子 是 维生素 、 矿 物质 和 水 。 


准备 工作 


让 我 们 从 准备 数据 开始 。 
第 1 步 : 收集 和 摘 述 数据 


为 了 应 用 k 均 值 聚 类 ， 我 们 使 用 采 自 不 同 食物 种 类 的 数据 集 进行 实验 ， 其 中 包含 了 每 种 食物 各 自 的 能 量 (Energy) 、 人 蛋白 质 
(Protein) 、 脂 肪 (Fat) . $5 (Calcium) 、 铁 (Iron) 等 含量 。 其 中 数值 型 变量 如 下 : 


: Energy 

: Protein 

: Fat 

: Calcium 

: Iron 

非 效 全 型 变量 如 下 : 


: Food 


ΞΕ. 

58255: 探索 数据 

版 本 信息 : 本 节 的 代码 在 R 3.2.3 中 测试 (2015-12-10) 5 
载 入 cluster () 库 。 


> library (cluster) 


探索 数据 并 理解 数据 变量 间 的 关系 。 从 导入 名 为 foodstuffs.txt 的 文本 文件 开始 ， 将 其 保存 在 food.energycontent 数 据 框 
中 。 


> food.energycontent «- read.table("d:/foodstuffs.txt", header-T) 


head () 函数 返回 向量 、 算 阵 、 表 、 数 据 框 或 函数 的 首尾 部 分 。 将 food.energycontent 数 据 框 传 入 head () RŽ: 


> head(food.energycontent) 


结果 如 下 : 


Food Energy Protein Fat Calcium Iron 


1 BB 340 20 28 9 2.6 
2 HR 245 21 17 9 2.7 
3 BR 420 15 39 7 2.0 
E BS 375 19 32 9 2.5 
5 BC 180 22 10 Af 3.7 
6 CB 115 20 3 8 1.4 


str () 函数 返回 food.energycontent 数 据 框 的 结构 信息 。 结 果 简 洁 地 显示 了 其 内 部 结构 。 


> str(food.energycontent) 


结果 如 下 : 
"data.frame”: 27 obs. of 6 variables: 
$ Food : Factor WA 27 levels "AC","AR", BB ,..: 314 67 á 9 10 5 16 17 ... 
$ Energy : int 340 245 420 375 180 115 170 160 265 300 ... 
$ Protein: int 20 21 15 19 22 20 25 26 20 18 ... 
$ Fat : int 2817 39321037 5 20 25 ... 
$ calcium: int 9 9 7 9 17 8121499. 
$ Iron : num 2.6 2.7 2 2.5 3.7 1.4 1.5 5.9 2.6 2.3 .. 


第 3 步 : 转换 数据 


apply () 函数 执行 了 数据 框 和 息 阵 中 逐个 元 素 的 数据 要 换 。 它 返回 一 个 向 量 、 效 组 、 链 表 ， 其 中 的 值 是 通过 应 用 一 个 
到 一 个 数组 或 矩阵 的 边 绿 。 其 中 2 代表 了 消 数 要 应 用 的 列 下 标 。sd 是 标准 差 浮 数 ， 用 于 这 个 数据 框 。 


42% 


`Z 


> standard.deviation «- apply(food.energycontent[,-1], 2, sd) 
» standard.deviation 


结果 如 下 : 


Energy Protein Fat Calcium Iron 
101. 207/7806 4.251696 11.25/033 78.034254 1.460857 





sweep () 国 数 返回 一 个 数组 ， 从 一 个 输入 数组 中 清除 一 些 统计 信息 。food.energycontent[，-1] 作 为 
中 2 代表 了 函数 要 应 用 的 列 下 标 。standard.deviation 是 需要 被 清除 的 统计 信息 。 


个 数组 传 入 。 其 


> foodergycnt.stddev <- 
sweep(food.energycontent[,-1],2,standard.deviation,FUNz"/") 
> foodergycnt.stddev 


结果 如 下 : 


Energy Protein Fat Calcium Iron 
1 3.3594247 4.704005 2.487/733386 0.11533397 1.7797775 
2 2.4207619 4.939205 1. 51016699 0.11533397 1.8482304 
3 4.1498775 3.528003 3.46450074 0.08970420 1.3690596 
4 3.7052478 4.468804 2.84266727 0.11533397 1.7113245 
5 1.7785189 5.174405 0.88833352 0.21785305 2. 5327602 
6 1.1362760 4.704005 0.26650006 0.10251908 0.9583417 
7 1.6797123 5.880006 0.62183347 0.15377862 1.0267947 
8 1.5809057 6.115206 0.44416676 0.17940839 4.0387258 
9 2.6183751 4.704005 1.77666704 0.11533397 1.7797775 
10 2.9641982 4.233604 2.22083381 0.11533397 1.5744185 
11 3.3594247 4.704005 2.48733386 0.11533397 1.7113245 
12 3.3594247 4.468804 2.57616721 0.11533397 1.7113245 
13 3.5076346 4.468804 2.66500057 0.11533397 1.6428715 
14 2.0255355 4.233604 1.24366693 0.08970420 1.7113245 
15 1.8279223 5.409605 0.79950017 0.11533397 1.8482304 
16 1.3338892 5.174405 0.35533341 0.32037213 0.4107179 
17 0.6916463 2.587203 0.08883335 1.05082059 4.1071788 
18 0.4446297 1.646402 0.08883335 0.94830150 3.6964609 
19 0.8892595 3.292803 0.17766670 0.48696564 0. 5476238 
20 1.3338892 3.763204 0.44416676 0.19222328 0.3422649 
21 1.9761322 4.468804 1.15483358 0.06407443 0.6845298 
22 1.5315024 3.763204 0.79950017 2.01193697 1.2321536 
23 1.9267289 3.763204 Ο. 97716687 0.17940839 0.889888/ 
24 1.1856793 3.998404 0.44416676 2.03756674 0.4791709 
25 1.7785189 5.174405 0.79950017 4.70306286 1.7113245 
26 1.6797123 5.880006 0.62183347 0.08970420 0.8214358 
27 1.0868727 5.409605 0.08883335 1.25585875 1.7797775 
第 4 步 : 聚 类 


kmeans () 函 数 施行 k 均 值 聚 类 到 数据 矩 孟 上 。 数 据 矩 阵 foodergycnt.stddev 入 当 作 一 个 对 象 传 入 ， 设 对象 是 一 个 数值 型 
矩阵。centers = 5 代表 初始 的 簇 中 心 数量 。iter.max= 100 代 表 最 大 的 迭代 轮 数 。 因 为 复数 量 由 一 个 数字 指定 ，nstart = 25 定 义 
了 随机 被 指定 的 组 数量 。 


> food.5cluster «- kmeans(foodergycnt.stddev, 
nstart-25) 
> food.5cluster 


centers-5, iter.max-100, 


结果 如 下 : 


K-means clustering with 5 clusters of sizes 2, 8, 8, 8, 1 


Cluster means: 

Energy Protein Fat Calcium Iron 
1 0.568138 2.116802 0.08883335 0.9995610 3.9018198 
2 1.414170 4.116004 0.57741679 0.6/43833 ο. 6910864 
3 1.759993 5.380205 0.77729183 0.27//1219 1. 9509099 
4 3.377951 4.410004 2.56506304 0.1121302 1.6599848 
5 1.778519 5.174405 0.79950017 4.7030629 1.7113245 


Clustering vector: 


[1]4344323344444332112222225433 


within cluster sum of squares by cluster: 
[1] 0.5626614 10.2035285 13.0477424 4.3254549 0.0000000 


(between 55 / total 55 = 78.4 X) 
Available components: 

[1] "cluster" "centers" "totss" "withinss" "tot.withinss" "betweens 
[7] "size" "iter" "ifault" 


> food.4cluster <- kmeans(foodergycnt.stddev, 
nstartz25) 
> food.4cluster 


centers-4, iter.max-100, 


结果 如 下 : 


K-means clustering with 4 clusters of sizes 3, 8, 2, 14 


Cluster means: 

Energy Protein Fat calcium Iron 
1.498567 4.312004 0.68105570 2.9175222 1.140883 
3.377951 4.410004 2.56506304 0. 1121302 1.659985 
0.568138 2.116802 0.08883335 0.9995610 3.901820 
1 


1 
2 
3 
4 1.619723 4.872005 0.68528586 0. 2544670 1.388618 


Clustering vector: 
[1]1242244442272244433444141144 

within cluster sum of squares by cluster: 

[1] 6.9589520 4.3254549 0.5626614 28.9804747 
(between 55 / total 55 - 68.6 X) 

Available components: 


[1] "cluster" "centers" "totss" "withinss" "tot.withinss" "betweens 
S" 


[7] "size" "iter" "fault" 


输出 4 个 族 的 聚 类 向 量 : 
> food.4cluster$cluster 


结果 如 下 : 


[1]24224444222224443344414114 4 


接 下 来 ， 输 出 4 个 聚 类 方案 的 聚 类 以 及 食品 标签 。 
lapply () 锐 数 返回 一 个 与 X 同 样 长 度 的 链表 : 


> food.4cluster.clust «- lapply(1:4, function (nc) 
protein[food.4cluster$cluster--nc]) 
> food.4Acluster.clust 


结果 如 下 : 


[[1]] 
[1] MC sC DC 
Levels: AC AR BB BC BH BR BS BT CB CC DC FB HF HR HS LL LS MB MC PF PR PS RC SC TC UC VC 


[[21] 
[1] BB BR BS LL LS HS PR PS 
Levels: AC AR BB BC BH BR BS BT CB CC DC FB HF HR HS LL LS MB MC PF PR PS RC SC TC UC VC 


[[31] 
[1] AR AC 
Levels: AC AR BB BC BH BR BS BT CB CC DC FB HF HR HS LL LS MB MC PF PR PS RC SC TC UC VC 


L[41] 
[1] HR BC CB CC BH BT VC FB TC HF MB PF UC RC 
Levels: AC AR BB BC BH BR BS BT CB CC DC FB HF HR HS LL LS MB MC PF PR PS RC SC TC UC VC 


使 用 pair () EREX^ERK— ΥΠΑ EE, 
food.energycontent[，-1] 通 过 给 定 一 个 矩阵 或 数据 框 的 数值 来 提供 点 的 坐标 。 


> pairs(food.energycontent[,-1], panel-function (x,y) 
text (x, y, food. Acluster$cluster)) 


结果 如 下 : 
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princomp () AAA EAER EAR DXEGT-EDK Ah. VAESEA TAE Γ3ΕΠΕΒΕΗΥΞΕΡΩΣ2ΊΤΕΕΓΕ. cor = TRENE 
E, 1ΒΒΗ͂ T iA AAEE, 


food.pc <- princomp(food.energycontent[,-1],cor-T) 
my.color.vector «- rep("green", times-nrow(food.energycontent)) 
my.color.vector[food.4cluster$cluster--2] «- "blue" 
my.color.vector[food.4cluster$cluster--3] <- "red" 
my.color.vector[food.4cluster$cluster--4] <- "orange" 


V V V V V 


par () 函数 整合 多 个 绘图 结果 到 一 个 统一 的 图 中 。s 产 生 一 个 正方 形 绘图 区 域 。 


> par (ptyz"s" ) 


绘制 这 个 聚 类 : 


> plot(food.pc$scores[,1], food.pc$scores[,2], 
ylim-range (food.pc$scores[,1]), 

+ xlab-"PC 1", ylab-"PC 2", type -'n', lwd=2) 

> text(food.pc$scores[,1], food.pc$scores[,2], labels-Food, cex-0.7, 
lwd-2, 

+ colzmy.color.vector) 


结果 如 下 : 


PG 2 
8 





第 4 章 ” 模 王选 择 和 正则 化 


本 章 将 涵盖 如 下 内 容 : 
` 压缩 方法 : 每 天 消耗 的 卡路里 
- 降 维 方法 : Delta 航 空 公司 航空 队 


' 主 成 分 分 析 : 理解 世界 菜 有 


子 集 选 择 : 使 用 标记 的 样本 来 训练 一 个 模型 ， 用 该 模型 将 样本 对 象 分 类 到 有 限 的 类 别 集合 中 ， 这 是 机 器 学 习 中 有 监督 分 类 的 
主要 挑战 乙 一 。 数 值 的 或 离散 的 特征 向 量 用 于 摘 述 不 同 的 样本 。 在 特征 子 集 选择 问题 中 ， 机 器 学 习 算法 面临 省 在 特征 向 量 中 选择 
一 些 特征 子 集 ， 并 舍 去 其 他 特征 以 集中 模型 注意 力 的 问题 。 


当 拟 合 线性 回归 模型 时 ， 最 能 摘 述 数据 的 特征 变量 子 集 是 最 有 价值 的 。 在 搜索 特征 变量 子 集 时 ， 有 很 多 不 同 的 方法 和 策略 可 
以 搜索 最 佳 子 集 。 如 果 有 样本 包 售 m 个 特征 变量 ,最 优 回归 模型 包 合 p 个 变量 ，p<m， 最 一 般 的 方法 是 通过 尝试 所 有 可 能 的 p 个 
变量 的 组 合 ， 挑 选 能 够 最 优 拟 合 数据 的 模型 来 挑选 特征 子 集 。 


但 是 ， 这 将 产生 m! p! (m-p) ! 个 可 能 的 组 合 ， 随 着 m 的 增加 ， 组 合 的 数量 将 迅速 增长 , 例如 ，m=20，p=4 将 产生 
4845 种 可 能 的 组 合 。 除 了 增强 模型 注意 力 的 好 处 之 外 ， 使 用 更 少 的 特征 ， 我 们 能 够 减少 处 理 数据 的 时 间 ， 并 增强 分 类 模型 的 可 
解释 性 。 


压缩 方法 : 压缩 回归 指 的 是 回归 问题 中 ，“ 售 计 ” 或 “预测 ”的 压缩 方法 ; 该 万 法 在 多 重 共 绪 性 回归 人 存 企 时 非常 有 效 。 在 效 
据 集 相 比 研究 的 协 变 量 的 数量 较 小 的 情况 下 ， 压 缩 技术 可 以 改进 预测 结果 。 常 用 的 压缩 方法 有 : 


- 线性 压缩 因子 一 一 用 同一 因子 压缩 所 有 系数 。 





- ἀρ 5 13 4&3] d AAA, 1463} EJ F 2826 ηλ 2 νε ἀκ’, 48 F Á 2k 27 2] 74055255 Ὁ 8] E EIT a o 
- lasso 通过 对 归 一 化 协 变量 系数 的 绝对 值 之 和 设置 约束 ， 将 茶 些 系数 缩减 为 零 。 





压缩 方法 保留 预测 器 的 一 个 子 集 ， 而 丢 乔 其 余 的 参数 。 子 集 选 择 法 能 够 产生 一 个 更 可 解释 的 模型 ， 访 模型 的 预测 误差 可 能 比 
全 模型 更 低 。 压 缩 方 法 更 为 连续 ， 且 使 异型 不 容易 受到 局 可 变性 的 影响 。 在 线性 回归 模型 中 ， 当 相 天 变量 较 多 时 ， 它 们 的 相 天 系 
数 很 难 确 定 ， 并 表现 出 较 遍 的 万 差 。 


降 维 万 法 : 降 维 方 法 是 多 个 信息 处 理 领域 的 重大 挑战 之 一 ， 包 括 模式 识别 、 数 据 压 缩 、 机 器 学 习 和 | 数据 库 泰 引 ， 它 是 一 种 流 
行 的 学 习 方 法 。 在 很 多 问题 中 ， 需 要 测量 的 数据 向 量 是 高 维 的 ， 但 数据 处 于 较 低 维 的 流 形 上 。 高 维 数 据 的 主要 挑战 在 于 它 的 复杂 
性 ; 它 则 接 测量 了 数据 的 潜在 特征 ， 这 些 特征 通常 不 能 被 直接 测量 。 降 维 也 可 以 看 作 导 出 一 组 自由 度 的 过 程 ， 它 可 以 用 来 重 现 数 
据 集 的 大 部 分 可 变性 。 


42 EDA: 每 天 消耗 的 卡路里 


为 了 比较 人 类 的 代谢 率 ， 基 础 代谢 率 (basal metabolic rate, BMR) 的 概念 是 至 关 重 要 的 ,该 指标 在 临床 中 作为 测定 人 类 
甲状 腺 功能 状态 的 一 种 手段 。 哺 乳 动 物 的 基础 代谢 率 的 变化 与 体重 、 现 场 代 谢 率 相同 的 异 速 生长 指数 以 及 许多 生理 生化 率 都 有 相 
关 性 。Fitbit 是 一 个 使 用 全 天 的 BMR 和 运动 量 指标 来 估计 全 天 卡路里 消耗 量 的 一 种 小 置 。 


准备 工作 


为 了 应 用 压缩 方法 ， 我 们 使 用 采集 目 Fitbit 的 数据 集 和 一 个 有 关卡 路 里 消耗 量 的 数据 集 。 
第 1 步 : 收集 和 摘 述 数据 


该 任务 使 用 名 为 fitbit_export_20160806.csv 的 数据 集 ， 访 数据 集 以 标准 格式 存储 在 CSV 格 式 的 文件 中 ， 其 中 包含 30 行 数据 
和 10 个 变量 。 其 中 数值 型 变量 如 下 : 


* Calories Burned 
' Steps 
: Distance 
: Floors 
: Minutes Sedentary 
: Minutes Lightly Active 
: Minutes Fairly Active 
: ExAng 
: Minutes Vety Active 
: Activity Calories 
非 数 值 型 变量 如 下 : 


: Date 


具体 实施 步骤 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 
首先 ， 我 们 载 入 下 面 的 库 : 


install.packages ("glmnet") 
install.packages ("dplyr") 
install.packages ("tidyr") 
install.packages ("ggplot2") 
install.packages ("caret") 
install.packages ("boot") 
install.packages ("RColorBrewer") 
install.packages ("Metrics") 
library (dplyr) 

library (tidyr) 

library (ggplot2) 

library (caret) 

library (glmnet) 

library (boot) 

library (RColorBrewer) 
library (Metrics) 


V V V V V V V V V V V V V V V V 


版 本 信息 : 本 节 的 代码 在 R 3.3.0 中 测试 (2016-05-03) ο 


让 我 们 探索 数据 并 理解 数据 间 的 天 系 。 从 导入 名 为 fitbit_exprt_20160806.csv 的 CSV 文 件 开 始 ， 将 数据 保存 到 fitbit_details 


数据 框 中 : 


> fitbit details <- 


read.csv("https://raw.githubusercontent.com/ellisp/ellisp.github.io/source/ 


data/fitbit export 20160806.csv", 
+ skip = 1, stringsAsFactors = FALSE) $»$ 
mutate ( 


Steps - as.numeric(gsub(",", "", Steps)), 


Date = as.Date (Date, format = "£d/$m/$Y") 
) 


+ + + + + + 


将 fitbit_details 数 据 框 保存 到 fitbit 数 据 框 中 : 


> fitbit «- fitbit details 


输出 fitbit 数 据 框 。head () 函数 返回 fitbit 数 据 框 的 头 部 数据 。fitbit 数 据 框 被 作为 输入 参数 传 入 : 


> head(fitbit) 


结果 如 下 : 


Calories.Burned = as.numeric(gsub(",", "", Calories.Burned)), 


Activity.Calories - as.numeric(gsub(",", "", Activity.Calories)), 


Date Calories.Burned Steps Distance Floors Minutes.Sedentary Minutes.Lightly.Active Minutes.Fairly.Active Minutes.Very.Active 
1 18 60 


1 2016-07-07 2682 12541 9.02 


2 2016-07-08 2423 38029 5.70 35 760 208 

3 2016-07-09 2875 10801 7.67 3 496 148 

4 2016-07-10 2638 11997 8.52 22 771 248 

5 2016-07-11 2423 9039 6.42 12 714 232 

6 2016-07-12 3102 17721 12.58 8 519 226 
Activity.calories 

1 1248 

2 928 

3 1040 

4 1285 

5 1044 

6 1805 


设置 Activity.Calories 和 Date 的 值 为 NULL: 


> fitbit$Activity.Calories <- NULL 


» fitbit$Date «- NULL 


将 原 数据 缩放 为 每 干 步 卡路里 消耗 。 结 果 被 设置 在 fitbit$Ssteps 数 据 框 中 : 


> fitbit$Steps «- fitbit$Steps / 1000 


输出 fitbit$Steps 数 据 框 : 


> fitbit$Steps 


结果 如 下 : 


[1] 12.541 8.029 10.801 11.997 9.039 17.721 10. 544 10.047 4.733 12.056 11.791 10.721 13.007 13.401 15.281 11.337 7.738 


[18] 11.767 13.324 5.957 10.206 11.557 11.013 10.168 11.686 13.991 13.444 12.398 11.986 12. 858 


探索 所 有 的 候选 变量 。 用 于 计算 相关 系数 的 函数 如 下 : 


13 
18 

3 
10 
30 


> panel correlations <- function(x, y, digits = 2, prefix = "", 


cex.cor, ...){ 
4 combining multiple plots into one overall graph 
+ usr <- par("usr") 


+ on.exit (par (usr)) 

+ par(usr = c(0, 1, 0, 1)) 

# computing the absolute value 

* r «- abs(cor(x, v)) 

# Formatting object 

+ txt <- format (c(r, 0.123456789), digits = digits) [1] 
+ txt <- pasteO(prefix, txt) 

* if(missing(cex.cor)) cex.cor «- 0.8/strwidth(txt) 

+ text(0.5, 0.5, txt, cex = cex.cor * r) 

+3} 


RABAR EARE, pairs () 消 数 以 矩阵 的 形式 处 理 散 点 图 。fitbit 是 散 点 图 的 数据 集 。 距 离 直 接 从 Steps 变 量 中 计算 出 来 : 


> pairs(fitbit[ , -1], lower.panel = panel correlations, main 


"Pairwise Relationship - Fitbit's Measured Activities") 


结果 如 下 : 





两 两 关系 fi tbit 数 据 集 的 活动 度量 


4 6 8 10 12 ου vv [0ο UU 


1.00 


6 8 


500 700 


10 40 70 


0.80 0.80 


输出 fitbit 数 据 框 : 


> ggplot (fitbit, aes(x = Distance / Steps)) + geom rug() + 


geom density() +ggtitle("Stride Length Reverse- Engineered from Fitbit 
Data", subtitle - "Not all strides identical, due to rounding or other 


jitter") 


结果 如 下 : 


步 幅 长 度 一 一 从 Fitbit 数 据 集中 声称 


10 20 30 40 50 ου 70 





20 40 60 80 100 


10 18 


6 


40 100 


0 


150 250 


0 40 80 


不 是 所 有 的 步 幅 都 是 一 样 的 ， 因 为 四 省 五 入 或 其 他 拌 动 


density 


ΕΕ AIL T | [oci | pod | | 
0.7100 0.7125 0.7150 0.7175 
Distance/Steps 


第 3 步 : 构建 模型 


创建 典型 的 最 小 二 乘 估计 ，Steps 作 为 自 变量 ，Calories.Burned 作 为 因 变 量 。Im () 是 一 个 用 来 拟 合 线性 模型 的 函数 。 
Calories.Burned~Steps 是 一 个 方程 ，fitbit 是 数据 框 ， 结 果 存 储 在 moderate 数 据 框 中 : 


> moderate <- lm(Calories.Burned ~ Steps, data = fitbit) 


输出 moderate 数 据 框 : 


> moderate 


结果 如 下 : 


call: 
Im(formula = calories.Burned ~ Steps, data = fitbit) 


Coefficients: 
(Intercept) Steps 
1926. 27 68. 55 


对 moderate 数 据 框 中 的 数值 进行 四 舍 五 入 处 理 : 
> round (coef (moderate)) 
结果 如 下 : 


(Intercept) Steps 
1926 69 


绘制 预测 的 卡路里 值 以 及 模型 使 用 的 剩余 残 差 。plot () ARER BRIR. moderated tE F73— ΡΜ 
值 传 入 。bty 参 数 决 定 了 绘制 图 的 类 型 。 


> plot (moderate, which = 1, bty = "1", 
compared with Residuals") 


main - "Predicted Calories 


结果 如 下 : 





2400 2600 2800 3000 


拟 合 值 


检验 残 关 部 分 侯 目 相 天 函数 。pacf () 用 来 执行 偏 自 相关 遂 数 检验 。resid () 作为 一 个 放 数 计算 因 变 量 和 观测 数据 之 间 的 
孝 异 。moderate 作 为 数据 框 传 入 resid () 锐 数 来 计算 因 变 量 和 观测 数据 之 间 的 磊 异 : 


> pacf(resid(moderate), main = 


"Partial Autocorrelation of residuals 
from single variable regression") 


grid () 函数 地 加 网 格 到 数据 绘图 中 : 


> grid() 


结果 如 下 : 





Partial ACF 





Lag 


基于 所 有 7 个 解释 性 的 变量 预测 每 日 的 卡路里 消耗 。 — i 个 样本 进行 模型 拟 合 ， 使 用 拟 合 出 的 模型 对 原 
始 样本 中 不 再 重复 采样 的 out of bag 样 本 点 进行 预测 。 该 方法 通过 选择 一 个 合适 的 alpha 值 在 极端 的 岭 回归 和 lasso 估 计 间 保持 平 
衡 。 


通过 归 一 化 创建 x 和 起 阵 。as.matrix () 辫 数 将 fitbit[，-1] 进 行 转换 ， 即 将 日 期 惠 剔除 后 的 数据 转换 成 起 阵 : 


> X <- as.matrix(fitbit[ , -1]) 


输出 X 数 据 框 ，head () 遂 数 返回 X 数 据 框 的 头 部 数据 。X 数 据 框 被 当 作 输 入 参数 传 入 : 


> head(X) 
结果 如 下 : 

Steps Distance Floors Minutes.Sedentary Minutes.Lightly.Active Minutes.Fairly.Active Minutes.Vvery.Active 
[1,] 12.541 9.02 13 667 171 18 60 
[2,] 8.029 5.70 35 760 208 13 6 
[3,] 10.801 7.67 3 496 148 18 46 
[4,] 11.997 8.52 22 771 248 3 27 
[5,] 9.039 6.42 12 714 232 10 16 
[6,] 17.721 12.58 8 519 226 30 107 


386534 UH — H8 gY [9] : 


> Y <- fitbit$Calories.Burned 


输出 Y 数 据 框 : 


结果 如 下 : 


[1] 2682 2423 2875 2638 2423 3102 2450 2555 2245 2936 2717 2690 3147 2837 2851 2611 2307 3109 3164 2593 2490 263 
8 2769 2629 


[25] 2555 3010 2694 2713 2640 2680 


» set.seed(123) 


生成 规则 序列 : 
> alphas «- seq(from = 0, to = 1, length.out = 10) 
» res «- matrix(0, nrow - length(alphas), ncol - 6) 
每 个 CV 过 程 重复 5 次 


for(i in 1:length(alphas))( 

fori] in 2:6) 

k-fold cross-validation for glmnet 

cvmod <- cv.glmnet(X, Y, alpha = alphas[i]) 

res[i, c(1, 1)] <- c(alphas[i], sqrt (min(cvmod$cvm))) 


) 
} 


+ + + + # + V 


创建 要 使 用 的 数据 集 。data.frame () 函数 基于 一 组 紧 耦 合 的 变量 创建 数据 框 。 这 些 变量 共享 短 阵 的 属性 : 


> res «- data.frame (res) 


输出 res 数 据 框 : 


> res 


结果 如 下 : 


x1 
. 0000000 
. 1111111 
-2222222 
. 3333333 
. 4444444 
- 3355556 
. 6666667 
. 7777778 
. 8888889 
. 0000000 


F ο QQ s O3 n E 5 N F 
= ο) ω ω — ο ο ο ο ω 


e 


x2 
109.5889 
108.6981 
106.9779 
111.2883 
109.0175 
107.8713 
106.9289 
108. 6405 
110.3589 
105.8732 


创建 average rmse 辣 量 : 


> res$average rmse 


107. 
109. 
108. 
109. 
110. 
109. 
113. 
107. 
116. 
111. 


输出 res$average rmse 向 量 : 


> res$average rmse 


结果 如 下 : 


[1] 109.2894 108.6945 108.4060 109.9822 111.0122 108. 6028 106.0425 108.7103 109.5337 109.7035 


x3 
0899 
3370 
4218 
3242 
8455 
9792 
0265 
2/41 
6443 
4563 


104. 
110. 
113. 
106. 
107. 
106. 
106. 
110. 
105. 
107. 


apply (res [ 


x4 
8613 
0573 
9708 
8881 
9398 
3763 
6506 
9709 
5138 
1465 


y 4 


:6], 


x5 
111.7505 
106.2842 
102. 3/84 
111.5851 
117. 3966 
107. 85553 
103. 0891 
109.0754 
108.3451 
115.6756 


以 升序 排列 res$average rmse。 结 果 存 储 在 res 数 据 框 中 : 


> res <- res[order(res$average rmse), 


输出 res 数 据 框 : 


> res 


结果 如 下 : 


] 


xb 
113.1563 
109.0958 
110.2811 
110. 8253 
109. 8615 
110.9318 
100.5173 
107. 5905 
106.8064 
108.3659 


1, mean) 


ΧΙ x2 x3 x4 x5 X6 average rmse 


7 2O0.666666/ 106.9289 113.0265 106.6506 103.0891 100. 5173 106.0425 
3 0.2222222 106.9779 108.4218 113.9708 102.3784 110.2811 108.4060 
6 0.5555556 107.8713 109.9792 106.3763 107.8555 110.9318 108.6028 
2 0.1111111 108.6981 109.3370 110.0573 106.2842 109.0958 108. 6945 
5 0.7777778 108.6405 107.2741 110.9709 109.0754 107.5905 108.7103 
1 20.0000000 109.5889 107.0899 104.8613 111.7505 113.1563 109.2894 
9 0.8888889 110.3589 116.6443 105. 5138 108.3451 106. 8064 109. 5337 
10 1.0000000 105.8732 111.4563 107.1465 115.6756 108. 3659 109.7035 
4 0.3333333 111.2883 109.3242 106.8881 111.5851 110.8253 109. 9822 
5 0.4444444 109.0175 110.8455 107.9398 117.3966 109.8615 111.0122 
> names(res)[1] <- "alpha" 

> res $»$ 

+ select(-average rmse) $»$ 

+ gather (trial, rmse, -alpha) $»$ 

+ ggplot(aes(x = alpha, y = rmse)) + 

+ geom point() + 

+ geom smooth(se = FALSE) + 

+ labs(y = "Root Mean Square Error") + 

+ ggtitle("Cross Validation best RMSE for differing values of alpha") 





结果 如 下 : 
不 同 alpha 下 交叉 验证 的 最 优 RMSE fH 
115. | 
xj 110 
ne 
ΤΕ | l : ; 
js | 
g 105. 
110: | | | | | 
0.00 0.25 0.50 0.75 1.00 
alpha 


> bestalpha <- res[1, 1] 


输出 bestalpha 数 据 框 : 


> bestalpha 


[1] 0. 6666667 


在 最 佳 alpha 值 下 决定 lambda。 通 过 调用 cv.glImnet () 函数 对 glmnet 计 算 k 折 交叉 验证 : 


> crossvalidated «- cv.glmnet(X, Y, alpha = bestalpha) 


创建 模型 。glmnet () AŽ A RAIRA AMST M ZbhEBSED EUn A assot iE HM 2:3xlambdaZife& 
网 格 的 弹性 网 络 (elasticnet) 惩罚 。X 是 输入 矩阵 ，Y 是 因 变 量 。alpha 是 弹性 网 络 混合 参数 ，0<Qax<1: 


> moderatel1 <- glmnet (X, Y, 


创建 一 个 典型 的 最 小 二 乘 估计 ，fitbit 作 为 自 变量 ，Calories.Burned 作 为 因 变量 。Im () 作为 
Calories.Burned ~ Steps 是 方程 ，fitbit 是 数据 框 。 结 果 保 存在 OLSmodel 数 据 框 中 。 


> OLSmodel <- lm(Calories.Burned ~ ., 


alpha = 


data 


输出 OLSmodel 数 据 框 : 


> OLSmodel 


结果 如 下 : 
call: 
Im(formula = Calories.Burned ~ ., data = fitbit) 
coefficients: 
(intercept) Steps 
1941.1889 -66. 8266 
Minutes.Lightly.Active — Minutes.Fairly.Active 
2.2466 4.4016 


N 


bestalpha) 


E1tbit) 


Distance 
116.0772 


Minutes.Very.Active 


3.8955 





^ ERAI 2 EET, 


Floors 
0.0274 


Minutes. Sedentary 
-0.2458 


比较 典型 的 最 小 二 乘 等 式 ， 并 使 用 弹性 网 络 对 8 个 系数 (7 个 可 解释 性 变量 加 1 个 截断 ) 进行 数值 估计 。 


> coeffs «- data.frame(original = 


+ shrunk = as.vector (coef (moderatel, 


crossvalidatedS$lambda.min)), 


t very.shrunk - 


crossvalidatedS$lambda.1se))) 


输出 coeffs 数 据 框 : 
> coeffs 
结果 如 下 : 

original shrunk 
(intercept) 1941.18889510 1953.9193828 
steps -66. 82663867 7.7214570 
Distance 116.07718793 14. 3140006 
Floors 0.02740202 0. 0000000 
Minutes. Sedentary -0. 24578123 -0. 2388018 
Minutes.Lightly.Active 2.24661181 2.1139746 
Minutes.Fairly.Active 4.40164035 4.4040703 
Minutes. Very.Active 3.89545935 3. 6009476 


对 moderate 数 据 框 的 值 进行 三 位 有 效 数 字 的 四 舍 五 入 : 


> round(coeffs, 3) 


结果 如 下 : 


s = 


as.vector(coef(moderatel, 


coef (OLSmodel), 


s = 


very. shrunk 


2176. 
15. 
22. 

0. 

-0. 

0. 

3. 

0. 


9301681 
9566697 
1799747 
0000000 
1801439 
7914329 
7619668 
8484609 


original shrunk very.shrunk 


(intercept) 1941.189 1971.199 2157.172 
steps -66. 827 9.176 15.703 
Distance 116.077 15.045 21.835 
Floors 0.027 0. 000 0.000 
Minutes. Sedentary -0.246 -0.236 -0.187 
Minutes.Lightly.Active 2.247 1.985 0.888 
Minutes.Fairly.Active 4.402 4. 384 3.842 
Minutes.Vvery.Active 3.895 3.295 1.019 


创建 模型 。glmnet () 国 数 通过 有 惩罚 的 极 大 似 然 拟 合 广义 线性 模型 。 
> moderate2 «- glmnet(X, Y, lambda = 0) 


输出 moderate2 数 据 框 : 


> moderate2 


结果 如 下 : 


Call: gimnet(x = X, y = Y, lambda = 0) 


Df XDev Lambda 
[1,] 7 0.8806 0 


进行 三 位 有 效 数 字 的 四 舍 五 入 : 


> round(data.frame("elastic, lambda = 0" = as.vector(coef (moderate2)), 
"lm" = coef(OLSmodel), check.names = FALSE), 3) 
结果 如 下 : 

elastic, lambda = 0 Im 
(Intercept) 1937.924 1941.189 
steps 15.455 -66.827 
Distance 0.653 116.077 
Floors 0.011 ο. 027 
Minutes. Sedentary -0.241 -0.246 
Minutes.Lightly. Active 2.236 2.247 
Minutes. Fair ly.Active 4.415 4.402 
Minutes.Very.Active 3. 894 3.895 


创建 模型 。 在 忽略 距离 列 的 数值 之 后 ，glmnet () 通过 有 惩罚 的 极 大 似 然 拟 合 广义 线性 模型 。 
> moderate3 «- glmnet(X[ , -2], Y, lambda = 0) 


输出 moderate3 数 据 框 : 


> moderate3 


结果 如 下 : 


Call: qlmnet(x = x[, -2], y = v, lambda = 0) 


Df XDev Lambda 
[1,] 6 0.8806 D 


创建 典型 的 最 小 二 乘 估计 。Y ~ X[，-2] 是 方程 。 结 果 和 存储 在 moderate4 数 据 框 中 : 


> moderate4 <- lm(Y ~ X[ , -2]) 


LA ata a a wr γι RE. 


输出 moderate4 数 据 框 : 


> moderate4 


结果 如 下 : 


call: 
Im(formula = v ~ x[, -2]) 


coefficients: 
(intercept) x[, -215τερ5 X[, -2]Floors X[, -2]Minutes. sedentary 
1. 9138603 1. 1280601 9.739e-03 -2.406e-01 
X[, -2]Minutes.Lightly.Active χ[, -2]Minutes.Fairly.Active X[, -2]Minutes. Very. Active 
2. 239e+00 4.413e+00 3. 906e+00 


对 结果 进行 三 位 有 效 效 字 的 四 舍 五 入 : 


> round(data.frame("elastic, lambda = O0" = as.vector(coef (moderate3)), 
"lm" = coef(moderate4), check.names = FALSE), 3) 

结果 如 下 : 

elastic, lambda = 0 Im 
(Intercept) 1938.103 1938.129 
x[, -2]Steps 15.885 15.798 
x[, -2]Floors 0.011 0.010 
X[, -2]Minutes. sedentary -0.241 -0.241 
X[, -2]Minutes.Lightly. Active 2.236 2.239 
x[, -2]Minutes.Fairly.Active 4.415 4.413 
X[, -2]Minutes. very. Active 3.897 3. 906 


第 5 步 : 比较 模型 


通过 目 举 法 (bootstrapping) 比较 不 同 模型 的 预测 强度 ， 建 模 方 法 是 通过 数据 重 米 样 目 举 。 该 模型 估计 之 后 用 于 预测 全 部 
的 原始 数据 集 


使 用 目 举 法 弹性 建 模 的 函数 如 下 : 


modellingfucnl <- function(data, 1) { 

X «— as.matrix(data[i , -1]) 

Y «- data[i , 1] 

k-fold cross-validation for glmnet 

crossvalidated «- cv.glmnet(X, Y, alpha - 1, nfolds - 30) 

Fitting a generalized linear model via penalized maximum likelihood 
moderatel «- glmnet(X, Y, alpha - 1) 


+ πε + 3ε + + V 


# Computing the root mean squared error 

+ rmse(predict(moderatel, newx = as.matrix(data[ , -1]), s = 
crossvalidated$lambda.min), data[ , 1]) 

+ } 


^ERK— RIS E ERAN Ease tRE( ES. fitbit, statisticemodellingfucnz&eSzA, KZA Ft&titbitid 
框 时 ， 返 回 包含 感 兴 趣 的 统计 数据 的 向 量 。R = 99 指 明了 自 举 重复 的 次 数 。 


> elastic boot <- boot (fitbit, statistic = modellingfucni1, R = 99) 


输出 elastic boot 数据 框 : 


> elastic boot 


结果 如 下 : 


ORDINARY NONPARAMETRIC BOOTSTRAP 


call: 
boot(data = fitbit, statistic = modellingfucnl, R = 99) 


Bootstrap Statistics : 
original bias std. error 
tl* 81.87882 13.92733 9. 038867 


进行 OLs 建 模 的 目 举 法 冰 数 : 


> modellingOLS <- function (data, i){ 
+ mod0 <- lm(Calories.Burned ~ Steps, data = data[i, 1) 


+ rmse (predict (moderate, newdata = data), data[ , 1]) 
+ ) 


生成 一 个 R 语 言 函 数 对 自 举 结果 进行 统计 。fitbit 是 数据 集 ，statistic=modellingOLS 是 函数 。 当 将 该 函数 应 用 给 fitbit 数 据 
框 时 ， 返 回 包含 感 兴 趣 的 统计 数据 的 向 量 。R = 99 指 明了 自 举重 复 的 次 数 。 


> lmOLS boot <- boot (fitbit, statistic = modellingOLS, R = 99) 


输出 ImOLS _ boot 数据 框 : 


> lmOLS boot 


结果 如 下 : 
ORDINARY NONPARAMETRIC BOOTSTRAP 


Call: 
boot (data = fitbit, statistic = modellingfucn2, R = 99) 


Bootstrap Statistics : 


original bias std. error 
tl* 81.55149 18.15953 16.66511 


生成 一 个 R 语 言 函 数 对 自 举 结果 进行 统计 。fitbit 是 数据 集 ，statistic=modellingfucn2 是 函数 。 当 将 该 函数 应 用 给 fitbit 数 据 
框 时 ， 返 回 包含 感 兴趣 的 统计 数据 的 向 量 。R = 99 指 明了 目 举 重复 的 次 数 。 


> lm boot «- boot(fitbit, statistic = modellingfucn2, R = 99) 


输出 Im_boot 数 据 框 : 
> lm boot 
结果 如 下 : 
ORDINARY NONPARAMETRIC BOOTSTRAP 


Call: 
boot (data = fitbit, statistic = modellingoLS, R = 99) 


Bootstrap Statistics : 


original bias std. error 
t1* 159.7195 0 0 
> round(c("elastic modelling" = mean(elastic boot$t), 


+ "OLS modelling" = mean (lm boot$t), 
+ "OLS modelling, only one explanatory variable" = 
mean (lmOLS boot$t)), 1) 


结果 如 下 : 
elastic modelling οι5 modelling 
95.8 99.7 
OLS modelling, only one explanatory variable 
159.7 


使 用 尺度 缩放 的 变量 重新 拟 合 模型 。 


创建 模型 。glmnet () 通过 有 惩罚 的 极 大 似 然 拟 合 广义 线性 模型 。 


> ordering «- c(7,5,6,2,1,3,4) 

> par(mar = c(5.1, 4.1, 6.5, 1), bg = "grey90") 

> model scaled «- glmnet (scale (X), Y, alpha = bestalpha) 

> the palette <- brewer.pal(7, "Set1") 

> plot(model scaled, xvar = "dev", label = TRUE, col = the pallete, lwd 
= 2, main = "Increasing contribution of different explanatory variablesnas 


penalty for including them is relaxed") 


> legend("topleft", legend = colnames(X) [ordering], text.col = 
the palette[ordering], lwd = 2, bty = "n", col = the palette[ordering]) 


结果 如 下 : 


Minutes.Very.Active 


Minutes.Lightly Active 


e 
`x κ. 
— u Dis! a ee 


Steps 


Floors 
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0.4 
可 解释 的 分 数 俩 差 


43 REEDA: Delta 航 空 公司 航空 队 


机 队 规 划 是 任何 航空 公司 战略 规划 过 程 的 一 部 分 。 机 队 包 括 了 所 有 航空 公司 经 营 航 线 的 全 部 飞机 ， 以 及 一 些 特殊 种 类 的 飞 
机 。 航 空 公司 选择 飞机 购置 标准 的 依据 是 技术 /性 能 特征 、 经 济 和 金融 因素 、 环 境 法 规 和 约束 、 市 场 考虑 和 政策 现状 。 机 队 结 构 
是 航空 公司 长 期 战略 决策 的 关键 。 每 种 飞机 类 型 具有 不 同 的 技术 性 能 特征 ， 例 如 ， 能 够 在 最 大 飞行 距离 上 运载 有 效 载 答 的 能 力 。 
已 影响 看 公司 的 财务 状况 、 运 塞 成本， 特别 是 服务 特定 路 线 的 能 力 。 


准备 工作 


为 了 应 用 降 维 算法 ， 我 们 使 用 采集 目 Delta 舰 空 公司 航空 队 的 数据 集 。 
第 1 步 : 收集 和 摘 述 数据 


该 任务 使 用 名 为 delta.csv 的 数据 集 ， 该 数据 集 以 标准 格式 仓储 ， 其 中 包含 44 行 数据 和 34 个 变量 。 


具体 实施 步骤 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 
首先 载 入 如 下 库 : 


install.packages("rgl") 
install.packages("RColorBrewer") 
install.packages("scales") 
library(rgl) 


V V V V 


> library (RColorBrewer) 
> library(scales) 


版 本 信息 : 


本 节 的 代码 在 R 3.3.2 中 测试 (2016-10-31) 。 


让 我 们 探索 数据 和 变量 之 间 的 关系 。 从 导入 名 为 delta.csv 的 CSV 数 据 文 件 开始 ， 将 数据 人 存储 到 delta 数 据 框 中 : 


> delta <- read.csv(file-z"d:/delta.csv", 


row.names-1) 


探索 delta 数 据 框 的 内 部 结构 。str () 立 数 显示 数据 框 的 内 部 结构 。delta 数 据 框 被 当 作 一 个 R 对 象 传递 


> str(delta) 


结果 如 下 : 


'data.frame': 44 obs. of 
Seat.width. .club. 
Seat.Pitch..club. 
Seat..cClub. 
Seat.width..First.class.: 
Seat.Pitch..First.class.: 
Seats..First.Class. 
Seat.width. . Business. 
Seat. Pitch. . Business. 
Seats. . Business. 
Seat.width. .Eco.comfort. : 
Seat.Pitch..Eco.comfort. : 
Seats. . Eco. Comfort. 
seat.width. . Economy. 
seat. Pitch- . Economy. 
Seats. . Economy. 
Accommodation 
cruising. Speed. . mph. 
Range. .mi les. 
Engines 

wingspan. .ft. 
Tail.Height..ft. 
Length. .ft. 

wifi 

video 

Power 

Satellite 

Flat.bed 

Sleeper 

Club 

First.cClass 
Business 

Eco. Comfort 


Economy 


i^ i^ bó i ως ip^ i^ ων ip^ i^ iu^ i^ ip^ io^ i^ ip^ i^ ων iu^ iu^ i ip^ iu^ i iy^ iu^ bó ip^ i ων b i p^ 


num 
num 


: int 
: num 
: num 
: int 


num 
num 


: int 
: num 
: num 
= int 
: int 
: int 
: int 
: int 
: num 
: num 
: num 
: int 
: int 
: int 
: int 
: int 
: int 
: int 
: int 
: int 
: int 
: int 


3 variables: 
: num 
: int 
: int 


header-T, 


sep- " ; " F 


给 str () BŽ: 


019.40000000 š 
04400000000 

01200000000 

21 19.4 21 21 O O O O 19.6 21. 

36 40 36 36000037 37 . 

12 28 12 12 O O O O 12 12 
021002121212000. 

0 59 0 0 60 80 806000. 

0140032 34 34 34 O O ... 

17.2 0 17.2 17.2 18 18 18 18 18.1 17.2 ... 
34 0 34 34 35 35 35 35 34 34 ... 

18 O 18 18 30 32 32 32 15 18 ... 

17.2 017.2 17.2 18 18 1B 18 18.1 17.2 ... 
30.5 D 31.5 31.5 30.5 30.5 30.5 30.5 3L 30.5 ... 
96 0 120 120 181 168 227 232 83 94 ... 


126 54 150 150 243 243 293 298 110 124 ... 
517 517 517 517 531 531 531 531 504 517 ... 
2399 3119 2420 2420 6536 6536 5343 5343 1510 2925 ... 


2222 
112 112 
38.6 38. 


wn 
= 
μη 
μη 
m 
= 


HHOoHMOOOOOOH 
οσο. ο οι 
HHoOoPOOOOOOH 
HHOoPMOOOOOOH 
HHPOoOcOPMOPHO 
HHHOoOPOOPHO 
μ.ο ο ο | ο 
HHHoOoOHMOOHMHO 
HHoOoHPOOOOHOH 
ο ο ϱ Ὁ | | | | 


222222. 
112 1317 198 ... 

399.8 ¿Q 
189 . 


6 38.6 38.6 
123 123 


探索 与 飞机 物理 特性 有 关 的 中 间 变 量 : 8. KRE, Nnm. RAN, MEER, FeubeugETLength.Scatter EP, 


plot () 函数 是 一 个 绘制 R 对 象 的 通 


> plot(delta[,16:22], 
" red " ) 


结果 如 下 : 


HAZ. delta[, 


main = 


"Aircraft Physical Characteristics", 


16: 221 9 fl F 73 BEEN EF : 
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所 有 这 些 变 量 全 部 都 与 飞机 的 整体 尺寸 正 相 关 。 


第 3 步 : 应 用 主 成 分 分 析 





可 视 化 高 维 数据 集 ， 例 如 引擎 的 数量 。 对 数据 应 用 主 成 分 分 析 。princomp () 函数 对 delta 数 据 炬 阵 进 行 主 成 分 分 析 。 结 果 


保存 在 principal comp analysis 数据 框 中 ， 这 是 一 个 princomp 类 的 对 象 : 


> principal comp analysis <- princomp (delta) 


输出 principal comp analysis 数据 框 : 
> principal comp analysis 


结果 如 下 : 


Call: 
princomp(x = delta) 


Standard deviations: 


Comp. 1 Comp. 2 Comp. 3 Comp. 4 Comp. 5 Comp. 6 Comp. 7 Comp. 8 Comp. 9 Comp. 10 
ας. 6.907940e+01 2. 8717648601 2. 2599296101 1. 4829626101 1. 0490146801 9.152229e400 7. 937495εἑ100 4. 5230396100 3. 623724ε100 2. 606 
a 12 comp. 13 comp. 14 comp.15 comp.16 comp. 17 comp. 18 comp. 19 comp. 20 Comp. 21 
“NPP 1.760506e+00 1. 563002e+00 1.245856e+00 4.772154e-01 3.806455e-01 3.493458e-01 2.724929e-01 2.153123e-01 1.991243e-01 1.669 
— 23 comp. 24 comp. 25 comp. 26 comp. 27 comp. 28 comp. 29 comp. 30 comp. 31 comp. 32 
1-340994e-01 1.209009e-01 6.524198e-02 4.241346e-02 2.373915e-02 2.016179e-03 2.452124e-05 0.000000e+00 0.000000e+00 0.000000e+00 0.000 

e+ 


33 variables and 44 observations. 


绘制 principal comp analysis 数据 框 : 


> plot(principal comp analysis, main -"Principal Components Analysis of 
Raw Data", col -"blue") 


结果 如 下 : 


原始 数据 的 主 成 分 分 析 


4e*06 58406 


26-06 


PEE 


$ 
2e+06 


1e+06 





0e+00 


Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8 Comp.9 Comp. 10 


显而易见 ， 第 一 个 主 成 分 有 一 个 贡献 数据 方差 超过 99.8% 的 标准 差 。 
输出 主 成 分 分 析 的 载 入 过 程 。loading () 函数 使 用 principal comp analysis 主 成 分 分 析 数 据 对 象 作为 输入 : 


> loadings (principal comp analysis) 


结果 如 下 : 


πι Comp.1 Comp.2 Comp.3 Comp.4 comp.5 comp.6 comp.7 ςοπρ.8 comp.9 comp.10 comp.11 comp.12 comp.13 Comp-14 comp.15 
ο... -Club. -0.144 -0.110 -0.165 
0.105 
Seat.Pitch. .club. -0.327 -0.248 0.189 -0.374 0.121  À 0.174 0.119 
0.239 
Seat..cClub. -0.102 
Seat.Width. .First.Class. 0.250 -0.160 -0.156 0.136 -0.246 0.341 -0.128 0.429 0.371 
"καν .First.class. 0.515 -0.110 -0.386 0.112 -0.130 0.183 0.161 -0.307 0.211 -0.389 -0.424 
Seats..First.cClass. 0.258 -0.124 -0.307 -0.109 20.160 0.149 0. 313 0.172 -0.242 -0.659 0.361 
Seat .width. . Business. -0.154 0.142 -0.108 0.244 -0.480 0.255 -0.232 -0.393 
S μη -0.514 0.446 -0.298 0.154 -0.172 0.379 0.285 0.401 
Seats..Business. -0.225 0.187 -0.287 -0.608 -0.29% -0.133 -0.503 -0.294 
seat .width. . Eco. Comfort. 0.285 -0.224 -0.113 0.111 
mU «αἱ Ee 0.159 0.544 -0.442 -0.268 0.260 0.120 
E αι... 0.200 -0.160 -0.208 0.318 -0.733 0.156 0.437 
un lil: .Economy. 0.125 20.110 0.186 -0.110 
c κ. . Economy. 0.227 0.190 -0.130 0.262 -0.104 -0.132 
eg 0. 597 -0.136 0.345 -0.165 0.168 0.597 -0.205 -0.127 
Accommodation ο. 697 -0.104 0.233 -0.592 0.183  À 0.153 0.152 
Cruising. Speed. . mph. 0.463 0.809 20.289 -0.144 0.115 
Range. .mi les. 0.999 


观察 loadings 的 第 一 列 ， 可 以 非 单 清楚 地 看 到 第 一 多 的 主 成 分 只 有 以 英里 计 的 Range (航程 ) 。 数 据 集中 每 一 个 变量 的 尺度 
都 不 同 。 


在 归 一 化 尺度 上 绘制 变量 。barplot () 函数 绘制 垂直 或 水 平 柱状 图 。sapply () 函数 是 一 个 包 委 六 数 ， 返 回 delta 变 量 同 样 
长 度 的 链表 。horiz=T 是 一 个 逻辑 值 ， 指 明 柱 状 图 应 该 水 平 绘制 ， 同 时 第 一 个 数据 在 讨 部 。 


> mar <- par()$mar 
> par(mar-martc(0,5,0,0)) 


» barplot(sapply(delta, var), horiz-T, las-1, cex.names-0.8, main - 
"Regular Scaling of Variance", col = "Red", xlab = "Variance") 


结果 如 下 : 


方差 正则 缩放 


Economy | 
Eco Comfort | 
Business | 
First Class | 
Club | 

Sleeper | 

Flat bed | 
Satelite | 
Power | 

Video | 

Wifi | 

Length. ft. | 
Tail.Height. ft. | 
Wingspan tt. | 
Engines | 
Range ci; zmzuzz==w== cFF a s nT tr F Hasa YF 
Cruising.Speed..mph. | 
Accommodation | 
Seats.Economy. | 
SeatPitch.Economy. | 
Seat. Width. Economy. | 
Seats..Eco.Comfort. | 
Seat ΡΗΟΠ. Εεο Comfort. | 
Seat Width..Eco.Comfort. | 
Seats. Business. | 

Seat Pitch. Business. | 
Seat.Width..Business. | 
Seats. First Class. | 

Seat Pitch. First Class. | 
Seat. Width..First.Class. | 
Seat. Club. | 
Seat.Prtch..Club. | 

Seat Width. Club. | 





0e-00 16-06 26106 36106 46-06 96-06 


Variance 


ENARE. barplot () AZÉRT EARRA: 


> barplot(sapply(delta, var), horiz-T, las-1, cex.names=0.8, log='x', 
main - "Logarithmic Scaling of Variance", col - "Blue", xlab - "Variance") 


结果 如 下 : 
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1e-01 1610 16103 16105 


Variance 


> par (mar=mar) 


第 4 步 : 缩放 数据 


delta 数 据 的 尺度 在 某 些 环境 下 非常 关键 ， 因 为 变量 在 不 同 的 尺度 范围 内 大 小 变化 很 大 。scale () 函数 是 一 个 用 来 中 心 化 并 
缩放 delta 和 矩 阵 各 列 的 函数 。 结 果 保 人 存在 delta2 数 据 框 中 : 


> delta2 <- data.frame(scale (delta)) 


验证 方差 是 否 一 致 : 


> plot(sapply(delta2, var), main = "Variances Across Different 
Variables", ylab - "Variances") 
结果 如 下 : 


1.000 1.005 1.010 


Variances 


0.995 





0.990 


Index 


目前 各 变量 的 方差 一 致 。 


应 用 主 成 分 分 析 到 缩放 过 的 数据 delta2。princomp () 函数 在 delta2 数 据 矩 孟 上 进行 主 成 分 分 析 。 结 果 保 仓 在 
principal comp analysis 数 据 杠 中， 该 数据 框 是 一 个 princomp 类 的 对 和 象 : 


> principal comp analysis «- princomp (delta2) 


绘制 principal comp _ analysis 对 象 : 


> plot(principal, comp analysis, main -"Principal Components Analysis of 
Scaled Data", col -"red") 


结果 如 下 : 


ΤΕ 


缩放 数据 的 主 成 分 分 析 
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Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8 Comp.9 Comp.10 
> plot(principal comp analysis, type-'l', main -"Principal Components 
Analysis of Scaled Data") 
结果 如 下 : 
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summary () 子 数 用 来 显示 多 种 不 同 模型 拟 合 函数 的 汇总 结果 : 
> summary (principal comp analysis) 
结果 如 下 : 
Importance of components: 
Comp.1 comp. 2 Comp. 3 Comp.4 Comp. 5 Comp. 6 Comp. 7 Comp. 8 Comp. 9 Comp.10 Comp.11 
standard deviation 3.6401340 2.7883991 2.2225223 1.21058843 1.14073049 1.01495084 0.87821658 0.70479857 0.5848836 0.529084330 0.407860804 


Proportion of variance 0.4108706 0.2410905 0.1531661 0.04544262 0.04034933 0.03194187 0.02391517 0.01540282 
Comp.12 Comp. 13 Comp.14 ` Comp.15 Comp.16 Comp.17 Comp. 18 
Proportion of variance 0.004067355 0.002768963 0.001765038 0.0012169 0.0009578654 0.0006465964 0.0005955958 


Cumulative Proportion  0.990691883 0.993460846 0.995225884 0.9964428 0.9974006493 0.9980472457 0. 9986428415 
comp. 22 Comp. 23 Comp. 24 Comp. 25 comp. 26 Comp. 27 C 


0.0106074 0.008680007 0.005158153 
Cumulative Proportion Ο.4108706 0.6519611 0.8051271 0.85056976 0.89091910 0.92286097 0.94677614 0.96217896 0.9727864 0.981466375 0.986624528 
Comp.19 Comp. 20 Comp. 21 
Standard deviation 0.362177038 0.298829473 0.238584294 0.1981036 0.1757588137 0.1444047596 0.1385927988 0.1173372505 0.1045097508 0.0853608392 
0.0004269157 0.0003386756 0.0002259371 
0.9990697572 0.9994084328 0.9996343699 


omp. 28 comp. 29 


comp. 30 


Standard deviation 0.0791201165 5.177928e-02 4.469526e-02 0.0221107242 1.530274e-02 1.080092e-02 3.619390e-03 4.267325e-08 4.071751e-08 
Proportion of variance 0.0001941083 8.313469e-05 6.194314e-05 0.0000151592 7.261202e-06 3.617359e-06 4.062012e-07 5.646532e-17 5.140824e-17 
cumulative Proportion 0. 9998284782 9.999116e-01 9.999736e-01 0.9999887152 9.999960e-01 9.999996e-01 1.000000e«00 1.000000e4«00 1.000000e-00 


Comp. 31 Comp.32 comp.33 
Standard deviation 9.643864e-09 7.10068e-09 0 
Proportion of variance 2.883848e-18 1.56340e-18 0 
Cumulative Proportion 1.000000e«00 1.00000e-00 1 


对 缩放 后 的 数据 delta2 进 行 主 成 分 分 析 。prcomp () ΜΕ delta221 B EEXECTZE REA 4. ΞΕΡΕΤΕ 
principal comp analysis 数据 框 中 ， 该 数据 框 是 一 个 prcomp 类 的 对 象 : 


> principal comp vectors «- prcomp(delta2) 


创建 principal comp vectors 数 据 框 : 


> comp <- data.frame(principal, comp vectors$x[,1:4]) 


施行 k=4 的 k 均 全 聚 类 。kmeans () 函数 对 comp 数 据 集 执行 k 均 值 聚 类 。nstart = 25 是 随机 集合 的 个 数 。iter.max=1000 
JE J OFIERA ORAN: 


> k means <- kmeans (comp, 4, nstart-25, iter.max-1000) 


创建 9 个 连续 色彩 的 向 量 : 


> palette (alpha (brewer.pal(9,'Set1'), 0.5)) 


绘制 Comp 数 据 框 : 


> plot (comp, col-k means$clust, pch-16) 


结果 如 下 : 


-8-4-2024 6 


4 2 0 2 4 6 


-4 -3 -2 1 0 1 2 








第 5 步 : IDITE 


绘制 comp$PC1、comp$PC2、comp$PC3 的 三 维 图 : 


> plot3d(comp$PC1, comp$PC2, comp$PC3, col-k means$clust) 


结果 如 下 : 





comp$PC3 


10 


comp$PC1 


绘制 comp$PC1、comp$PC3、comp$PC4 的 三 维 图 : 


> plot3d(comp$PC1, comp$PC3, comp$PC4, col-k means$clust) 


结果 如 下 : 





comp$PC1 


按照 每 个 类 的 大 小 从 低 到 高 排序 查看 聚 类 结果 : 


> sort(table(k means$clust)) 


结果 如 下 : 
2 4 3 1 
1 4 15 24 


» clust «- names(sort(table(k means$clust))) 


显示 第 1 个 聚 类 内 的 特征 名 称 : 


> row.names(delta[k means$clust==clust[1],]) 


结果 如 下 : 


[1] "Airbus A319 VIP" 


显示 第 2 个 聚 类 内 的 特征 名 称 : 


> row.names (delta[k means$clust--clust[2],]) 


结果 如 下 : 


[1] "CRI 100/200 Pinnacle/Skywest" “CRJ 100/200 ExpressJet" "E120" "ERJ-145" 


显示 第 3 个 聚 类 内 的 特征 名 称 : 


> row.names (delta[k means$clust--clust[3],]) 


+ ° 
结果 如 下 : 
[1] "Airbus A330-200" "Airbus A330-200 (312)" "Airbus A330-200 (3L3)" "Airbus A330-300" "Boeing 747-400 (745)” 
[6] "Boeing 757-200 (75E)" "Boeing 757-200 (75X)" "Boeing 767-300 (76G)" "Boeing 767-300 (761)" "Boeing 767-300 (76T)" 
[11] "Boeing 767-300 (767 v.1)" "Boeing 767-300 (7672 v.2)" "Boeing 767-400 (76D)" "Boeing 777-200ER" "Boeing 777-200LR" 


显示 第 4 个 聚 类 内 的 特征 名 称 : 


> row.names (delta[k means$clust--clust[4],]) 


结果 如 下 : 

[1] "Airbus A319™ "Airbus A320" "Airbus A320 32-R" "Boeing 717" "Boeing 737-700 (73W)" 
[6] "Boeing 737-800 (738)" "Boeing 737-800 (73H)" "Boeing 737-900ER (739)" "Boeing 757-200 (75A)" "Boeing 757-200 (75M)" 
[11] "Boeing 757-200 (75N)" "Boeing 757-200 (757)" "Boeing 757-200 (75ν)” "Boeing 757-300" "Boeing 767-300 (76P)" 
[16] "Boeing 767-300 (760)" "Boeing 767-300 (76U)"  "cRJ 700" "CRJ 900" "E170" 

[21] "E175" "MD-88" "MD-90" "MD-DC9-50" 


44 主 成 分 分 析 : 理解 世界 菜肴 


食物 是 我 们 是 谁 的 有 力 象征 。 有 多 种 食物 认同 的 万 式 ， 如 种 族 认 同 、 衬 教 认同 和 阶级 认同 。 在 “ 味 营 外 国人 ”出 现时 ， 民 族 
的 食物 倾向 变 成 了 身份 认同 的 标记 。 例 如 当 一 个 人 出 国 了 时， 或 当 这 些 外 国人 访问 我 们 的 家 乡 时 ， 饮 食 习 惯 的 不 同 成 为 了 区 分 国 别 
的 关键 特征 。 


准备 工作 


为 了 应 用 主 成 分 分 析 ， 我 们 使 用 采集 自 Epicurious | 菜谱 的 数据 集 。 
第 1 步 : 收集 和 摘 述 数据 


该 任务 使 用 名 为 epic_recipes.txt 的 数据 集 ， 数 据 以 标准 格式 存储 。 


具体 实施 步骤 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 


首先 是 载 入 如 下 库 : 


> install.packages("glmnet") 
> library (ggplot2) 
> library(glmnet) 


版 本 信息 : 本 节 的 代码 在 R 3.3.2 中 测试 (2016-10-31) 。 
让 我 们 探索 数据 和 变量 间 的 关系 。 从 导入 名 为 epic_recipes.txt 的 TXT 数据 文件 开始 ， 将 数据 保存 到 datafile 数 据 框 中 : 
> datafile «- file.path("d:","epic recipes.txt") 


以 表 的 格式 读 一 个 文件 并 基于 该 表 创建 数据 框 。datafile 是 文件 名 ， 作 为 输入 传 入 : 


> recipes data <- read.table(datafile, fill-TRUE, 
col.names-1:max(count.fields(datafile)), na.strings-c("", "NA"), 
stringsAsFactors - FALSE) 


第 3 步 : 准备 数据 


将 数据 分 裂 为 不 同 的 子 集 。aggregate () 分 离 recipes data[，-1] 数 据 集 并 计算 汇总 统计 量 。recipes data[，-1] 列 出 了 分 
组 元 素 ， 每 一 个 与 数据 框 中 的 变量 一 样 长 。 结 果 存 储 在 agg 数 据 框 中 : 


> agg «- aggregate(recipes data[,-1], by=list (recipes data[,1]), paste, 
collapsez",") 


创建 一 个 向 量 、 数 组 或 者 链表 : 
> agg$combined <- apply(agg[,2:ncol(agg)], 1, paste, collapse=",") 


对 指定 形式 的 元 素 进 行 蔡 换 。gsub () 是 一 个 替换 函数 ， 搜 索 agg$combined 数 据 框 后 用 "替换 所 有 的 NA。 


> agg$combined <- gsub(",NA","",agg$combined) 


把 所 有 菜谱 的 名 字 抽 取出 来 : 


> cuisines «- as.data.frame(table(recipes data[,1])) 


输出 菜谱 数据 框 : 


> cuisines 


结果 如 下 : 


varli Freg 


1 African 115 
2 American 4988 
3 Asian 1176 
4 Cajun creole 146 
5 central 5southamerican 241 
6 chinese 226 
7 EasternEuropean Russian 146 
8 English scottish 204 
9 French 996 
10 German 52 
11 Greek 225 
12 Indian 274 
13 Irish 86 
14 Italian 1715 
15 Japanese 136 
16 Jewish 320 
17 Mediterranean 289 
18 Mexican 622 
19 Middl]eEastern 248 
20 Moroccan 137 
21 scandinavian 92 
22 Southern soulFood 346 
23 Southwestern 108 
24 Spanish Portuguese 291 
25 Thai 164 
26 vietnamese 65 


抽取 菜谱 原料 的 出 现 频 率 : 


> ingredients freq «- lapply (lapply (strsplit (a$combined,","), table), 
as.data.frame) 
» names(ingredients freq) «- agg[,1] 


归 一 化 原料 频率 : 


proportion «- lapply(seq along(ingredients freq), function(i) { 
colnames (ingredients freq[[i]])[2] <- names (ingredients freq)[i] 
ingredients freq[[i]][,2] <- ingredients freq[[i]]I[,2]/cuisines[i,2] 
ingredients freq[[i]l]l) 

) 


+ + + + V 


列 出 26 个 元 素 ， 每 个 菜谱 一 个 : 


> names (proportion) <- a[,1] 
> final «- Reduce(function(...) merge(..., all=TRUE, by="Varl"), 
proportion) 


row.names(final) <- final[,1] 

final «- final[,-1] 

final[is.na(final)] < 0 

prop matrix <- t (final) 

s «— sort(apply(prop matrix, 2, sd), decreasing-TRUE) 


V V V V V 


scale () 为 数 中 心 化 并 拉 伸 prop_matrix 和 矩阵 的 每 一 询 。 结 果 人 存储 在 final_ imp 数据 框 中 : 


> final imp <- scale(subset(prop matrix, select-names (which(s > 0.1)))) 


创建 热度 图 。final imp? 数据 框 被 作为 输入 传 入 。trace= "none" 表 示 一 个 实 线 的 “trace” 线 是 否 应 该 被 画 在 行 间或 列 
间 ， 该 变量 的 取 值 可 以 是 “both” 或 “none”。key=TRUE 代 表 该 图 以 彩 图 形式 展示 : 


> heatmap.2(final imp, trace-"none", margins = σ(6,11), 
col-topo.colors(7), key-TRUE, key.title-zNA, keysize-1.2, 


density.info-"none") 


结果 如 下 : 
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cream 
butter 
lime_juice 
fish 
vegetable oil 
rice 

scallion 

soy sauce 
sesame oil 
ginger 
coriander 
turmeric 
cumin 

olive oil 
onion 

tomato 

corn 
cayenne 
cilantro 

garlic 


第 4 步 : 应 用 主 成 分 分 析 


对 该 数据 应 用 主 成 分 分 析 。princomp () AA final imp 数据 乱 孟 上 执行 主 成 分 分 析 。 结 果 保 存在 pca_ computation 数 
据 框 中 ， 该 数据 框 是 princomp 类 的 一 个 对 象 : 


> pca computation «- princomp(final imp) 


输出 pca_ computation Zt : 


» pca computation 


结果 如 下 : 


Call: 
princomp(x = final imp) 


standard deviations: 


Comp.1 Comp. 2 Comp. 3 Comp. 4 Comp. 5 comp. 6 Comp. 7 Comp. 8 Comp. 9 Comp.10 ζοπρ.11 Comp.12 
Comp. 13 
2.95664772 2.22248409 1.54442468 1.44724581 1.10369661 0.75612298 0.57781510 0.47944174 0.42994264 0.39243338 0.30441262 0.24488043 0.1 
9478279 


Comp. 14 Comp.15 Comp.16 ζοπρ. 17 Comp.18 Comp.19 Comp. 20 Comp. 21 Comp. 22 
0.16134688 0.13102208 0.10750934 0.10266234 0.08372124 0.04197352 0.03426400 0.02328061 0.01466105 


22 variables and 25 observations. 


绘制 碎 石 图 。pca_computation 数 据 框 是 princomp 类 的 一 个 对 象 。pc.biplot=TRUE 代 表 它 是 一 个 主 成 分 碎 石 图 : 


> biplot(pca computation, pc.biplot-TRUE, colzc("black","red"), 
cex-zc(0.9,0.8), xlim-c(-2.5,2.5), xlab="PC1, 39.7%", ylabz"PC2, 24.5%") 


结果 如 下 : 
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译 者 注 
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本 章 将 涵 蘑 如 下 内 容 : 
` 广义 加 性 模型 : 衡量 新 西 兰 的 家 庭 收入 
平滑 样 条 : 理解 汽车 和 速度 


. 局 部 回归 : 理解 干旱 警告 和 影响 


5.1 广义 加 性 模型 : 衡量 新 西 三 的 家 庭 收入 





收入 调查 为 个 人 和 家 庭 的 收入 水 平 提供 了 一 个 快照 。 收 入 水 平 是 通过 计算 多 个 数据 源 的 周 收入 中 位 数 或 平均 数 得 出 的 ， 进 而 
可 以 得 到 不 同人 群 收 入 的 对 比 数据 。 收 入 只 能 断断续续 获得 ， 而 消费 则 是 每 天 都 会 进行 的 。 因 此 有 理由 认为 ， 消 费 相 比 收入 来 
说 ， 与 当前 生活 水 平 有 更 直接 的 关系 ， 至 少 短期 是 如 此 。 


准备 工作 


为 了 应 用 压缩 万 法 ， 我 们 使 用 采集 目 新 西 生 2013 年 人 口 普查 的 数据 集 。 
第 1 步 : 收集 和 摘 述 数据 


nzcensus 数 据 包 包含 超过 60 个 新 西 兰 人 口 属性 信息 。 这 些 数 据 分 别 在 地 区 网 格 块 、 地 区 单元 、 区 政府 (territorial 
authority) 、 地 区 委员 会 (regional council) 的 级 别 被 累加 统计 。 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 
首先 需要 载 入 以 下 库 : 


devtools::install github("ellisp/nzelect/pkg2") 
library(leaflet) 
library (nzcensus) 
library (Metrics) 
library (ggplot2) 
library (scales) 
library (boot) 
library (dplyr) 
library (Hmisc) 
library (mgcv) 
library(caret) 
library (grid) 
library (stringr) 
library (ggrepel) 
library (glmnet) 
library (maps) 


V V V V V V V V V V V V V V V V 


从 数据 集中 移 除 Chatham 群 岛 的 数据 。AreaUnits2013 是 一 个 esriGeometryPolygon 几 何 类 型 对 象 。 它 定义 了 2013 年 人 口 
普查 的 地 区 单元 : 


> tmp «- AreaUnits2013[AreaUnits2013$WGS84Longitude» 0 & 
'is.na(AreaUnits2013$MedianIncome2013), ] 


创建 一 个 调 色 板 (palette) RŽI: 


> palette «- colorQuantile("RdBu", NULL, n = 10) 


创建 弹出 窗口 的 标签 。paste0 () ARAFE IRF ERER: 


> labels <- pasteO(tmp$AU NAM, " $", format (tmp$MedianIncome2013, 
big.mark = ",")) 


绘制 地 图 : 


> leaflet() 5»5 

addProviderTiles("CartoDB.Positron") $»$ 

addCircles(lng - tmp$WGS84Longitude, lat - tmp$WGS84Latitude, 
color - pal(-tmp$MedianIncome2013), 
popup labs, 
radius = 500) %>% 


addLegend( 
pal = pal, 
values - -tmp$MedianIncome2013, 
title = "Quantile of median«c«br»household income", 
position = "topleft", 
bins - 5) 


+ 
+ 
+ 
+ 
+ 
+ 
+ 
$ 
十 
- 
十 


结果 如 下 : 
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第 3 步 : 准备 模型 数据 


将 数据 转换 成 一 个 更 万 便 实 用 的 形式 。 去 除 地 区 编码 和 名 称 ， 以 及 多 余 的 坐标 系统 : 

> au <- AreaUnits2013 $»$ 

+ select(-AU2014, -AU NAM, -NZTM2000Easting, -NZTM2000Northing) $»$ 

+ select(-PropWorked40 49hours2013, -Prop35to39 2013, -PropFemale2013) 


> row.names(au) «- AreaUnits2013$AU NAM 


蔡 换 所 有 重复 的 数据 模式 。gsub () 函数 搜索 ”2013"、"2013" 和 "Prop"， 并 替换 为 names (au) : 


> names(au) «- gsub(" 2013", "", names (au)) 
» names(au) «- gsub("2013", "", names(au)) 
> names (au) <- gsub("Prop", "", names (au)) 


获取 标明 一 组 样 例 已 经 完成 处 理 的 逻辑 向 量 : 


> au <- au[complete.cases(au), | 





将 其 命名 为 一 个 更 加 通用 的 名 字 : 


> data use «- au 


探索 data_use 数 据 框 的 维度 。dim () BEZoERIBIdata use 数据 框 的 维度 。data _ use 数据 框 被 作为 输入 变量 传 入 。 结 果 显 而 
易 见 ， 该 数据 集 有 1785 行 数据 和 69 个 列 |: 


Ó` 


> dim(data use) 


结果 如 下 : 
[1] 1785 69 


> data use «- data use[the data$WGS84Longitude > 100, ] 


基于 字符 向 量 创建 并 设置 语法 有 效 的 名 字 。names () BRE Eidata useXJZRBS eA, PTERA AANA FRR RR 
回 的 字符 向 量 : 


> names(data use) «- make.names (names (data use)) 


显示 从 data_use 数 据 框 中 创建 的 名 字 : 


> names(data use) 


结果 如 下 : 


[1] "MeanBedrooms” "PrivateDwellings" "SeparateHouse" "Number InHH" "MultiPersonHH" 
[6] "rinternetHH" "NOotOwnedHH" "MedianRentHH" "LandlordPublic" "NoMotorvehicle" 
[11] "Arechi ldren" "sameResidence5vearsAgo"  "Overseas5YearsAgo" "NZBorn" "European" 
[16] "Maori" "Pacific" "Asian" "Male" "X20to24" 
[21] "x25to29" "X30to34" "X40to44" "X45to49" "X50to54" 
[26] "X55to59" "X60to64" "X65Andolder " "NoReligion" “smoker” 
[31] "separated" “Partnered” "OwnResidence” "Nochi ldren" "NoQualification" 
[36] "Bachelor" "Doctorate" "FTstudent" "PTSstudent" "Medi anincome" 
[41] "selfEmployed" "unemployment Benef i t " "studentAllowance" "FullTimekemployed" "PartTimeEmployed" 
[46] "unemployed" "Employee" "Employer" "selfEmployedNoEmployees" "Managers" 
[51] "Professionals" "Trades" "Labourers" "AgForFish" "PubAdmin" 
[56] "Finservices" "Profservices" "workedl 9hours" "workedlO 19hours" "worked20 29hours" 
[61] "worked3O 39hours" "worked50  59hours" "workedover6Ohours" "workedHome" "PublicTransport" 
[66] "walk3ogBike" "NounpaidActivities" "wGSB8ALongitude" "wGS8ALatitude" 


第 4 步 : 构建 模型 


估计 非 参 数 模型 的 强度 。spearman2 () 计算 斯 皮尔 曼 秩 等 级 相关 系数 (Spearman”s rho rank correlation) 的 平方 及 
其 一 般 化 形式 ， 该 一 般 化 形式 允许 x 能 够 与 y 呈 非 单 调 的 关系 。 这 项 工作 通过 计算 (rank (x) , rank (x) ^2) 和 y 间 的 斯 皮尔 
曼 多 重 秩 平方 来 实现 。 


> reg data <- spearman2(MedianIncome ~ ., data = data use) 


以 降序 排列 数据 : 


> reg data[order(-reg data[ ,6])[1:15], ] 


结果 如 下 : 

rho2 F αι df2 P Adjusted rho2 n 
FullTimeEemployed 0.7129141 4427. 5847 1 1783 Ü ο. 7127531 1785 
InternetHH 0.5834990 2497.9024 1 1783 Ü 0.5832654 1785 
NoQualification 0.4470782 1441. 6876 1 1783 Ü 0.446/681 17/785 
unemploymentBenefit 0.4308350 1349.6595 117830 0. 4305158 1785 
smoker 0.4094793 1236.3689 1 1783 0 0.4091481 1785 
Partnered 0.3866362 1123.9207 1 1783 Ü 0.3862922 17/785 
Managers 0.3854095 1118.1189 1 1783 O 0.3850648 1785 
Bachelor 0. 3723224 1057. 6304 1 1783 0 0.3719704 1785 
SelfEmployed 0.3664151 1031.1455 1 1783 Ü 0. 3660598 1785 
NoMotorVehicle 0.3584018 995.9976 1 1783 Ü 0.3580419 1785 
unemployed 0.3570226 990.0367 1 1783 O0 0.3566620 1785 
Labourers 0.3378065 909.5664 1 1783 Ü 0.3374351 1785 
worked50 59hours 0.331139? 882.7204 1 1783 Ü 0. 3307640 1785 
workedover6Ohours 0. 3311392 882.7264 117830 0. 3307640 1785 
separated 0.3122424 809.4831 1 1783 O0 0. 3118567 1785 


分 配 灵 活 的 样 条 函数 给 最 前 面 的 15 个 变量 。terms () 国 数 将 terms 对 象 从 多 个 R 数 据 对 象 中 抽取 出 来 : 


> reg formula «- terms (MedianIncome ~ 
s(FullTimeEmployed, k = 6) + 
s(InternetHH, k = 6) + 
s(NoQualification, k = 5) + 
s (UnemploymentBenefit, k = 5) + 
s (Smoker, k = 5) + 


拟 合 广义 加 性 模型 。reg formula 是 方程 ，data_use 是 数据 集 。 


> gam model «- gam(reg formula, data = data use) 


绘制 gam_model。 


> par(bty "L"; mar = 8(5,4, 2, 17) 

» par(mar - rep(2, 4)) 

» plot(gam model, residuals - TRUE, pages - 1, shade - TRUE, seWithMean 
= TRUE, ylab = "") 


结果 如 下 : 
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> rmses_gam_boot <- boot (data = data_use, statistic = fit_gam, R = 99) 


输出 rmses_ gam_boot 数 据 框 : 


> rmses gam boot 


结果 如 下 : 


ORDINARY NONPARAMETRIC BOOTSTRAP 


Call: 
boot(data = data use, statistic = fit gam, R = 99) 


Bootstrap Statistics : 
original bias std. error 
ti* 1639.39 244.9502 387.2537 


计算 rmses gam_boot$t 的 均值 : 


> gam rmse «- mean(rmses gam boot$t) 


输出 gam_rmse 数 据 框 : 


> gam rmse 
结果 如 下 : 


[1] 1884.34 


5.2 平滑 样 条 : 理解 汽车 和 速度 


在 统计 学 中 ， 为 了 确定 拟 合 模型 所 需 的 参数 ， 可 以 使 用 多 种 方法 。 在 每 个 方法 中 ， 参 数 拟 合 都 涉及 基于 数据 进行 参数 估计 。 
除了 参数 估计 外 ， 两 个 重要 阶段 是 识别 合适 的 模型 和 模型 的 验证 。 平 滑 方法 可 以 在 多 个 阶段 使 用 : 帮助 理解 和 生成 平滑 图 像 ， 从 
平滑 后 的 数据 分 布 中 找 出 合适 的 参数 模型 ， 或 者 集中 加 强 兴趣 点 的 影响 ， 以 消除 无 用 噪声 市 来 的 干扰 。 


具体 实施 步骤 


以 下 为 实现 细节 。 
第 1 步 : 探索 数据 
首先 是 载 入 以 下 库 : 


install.packages ("graphics") 
install.packages ("splines") 
library (graphics) 
library (splines) 


V V V V 


创建 一 个 矩阵 。cbind () 遂 数 生成 一 个 数字 序列 并 创建 一 个 矩阵 。 结 果 随 后 被 传 给 matrix () μι, VAERENGUER— ΠΤ 
的 和 埠 阵 。 结 果 保存 在 matrix 数 据 框 中 : 


> matrx = matrix(cbind(1,.99, .99,1),nrow-2) 


第 2 步 : 创建 模型 
Cholesky 分 解 产 生 正 定 和 矩阵 A，A 被 分 解 为 A=LLT， 上 [是 一 个 下 三 角 和 矩阵 ， 其 中 对 角 元 素 为 正 值 。chol () 函数 计算 一 个 实 
数 的 、 对 称 的 、 正 定 矩 阵 的 Cholesky 分 解 。 结 果 存 储 在 cholsky 变 量 中 : 


> cholsky = t (chol (matrx)) 
» nvars - dim(cholsky) [1] 


[1] 2 
密度 分 布 的 观测 值 数量 如 下 : 


> numobs = 1000 
> set.seed(1) 


使 用 正 态 分 布 计 算 和 矩阵 。rnorm () 计算 正 态 分 布 ， 使 用 numobs 作 为 观测 值 数量 。 使 用 matrix () 子 数 进行 矩阵 计 


算 ，nrow=nvars 行 数 取 值 为 2，ncol=numobs 列 数 取 值 为 1000。 结 果 存 储 在 random _normal 中 : 


=> 


> random normal = matrix(rnorm(nvars*numobs,10,1), nrow=nvars, 


ncol=numobs) 

进行 矩阵 乘法 运算 。cholsky 乘 以 矩阵 random_normal: 
> X = cholsky $*$ random normal 

EE EIREEX : 


» newX - t(X) 


创建 一 个 和 矩阵 的 数据 框 。as.data.frame () ERZK6lgES7JrawBSZidistE, ΙΣΠ ΡΕ EsnewXBgsezSEZUSSO, EnewXBE 


共享 许多 属性 : 


> raw = as.data.frame(newX) 
输出 raw 数 据 框 。head () 函数 返回 raw 数 据 框 的 头 部 数据 。raw 数 据 框 补 当 作 输入 参数 传 入 : 


> head(raw) 


结果 如 下 : 


v1 v2 
1 9.113850 10.162218 
2 11.619701 12.987429 
3 9.944150 11.353624 
4 10.053516 11.178816 
3 7.876934 9.179485 
6 9.687213 10.851732 


创建 random_normal 的 转 置 数据 框 。t () AÁ Ærandom normaBBPERJA£EBEE, $£ESBPIESIRIBABEESER EU, 
并 共享 许多 属性 : 
> raw original = as.data.frame(t(random normal)) 


合并 response 和 predictor1 成 为 names。c () 函数 将 参数 response 和 predictor1 合 并 成 一 个 向 量 : 


> names (raw) = c("response","predictor1") 


raw$predictor18932X182408 : 
> raw$predictorl1 3 = raw$predictor1^3 


输出 raw$predictor1 3 数据 框 。head () 函数 返回 raw$predictor1 3 数据 框 的 头 部 数据 。raw$predictor1 3 数据 框 被 当 作 
输入 参数 传 入 : 


> head (raw$predictorl 3) 
结果 如 下 : 


[1] 1049.4591 2190. 6329 1463.5364 1396.9711 773.4905 1277.9010 


raw$predictor18927X 38 : 
> raw$predictorl1 2 = raw$predictor1^2 


输出 raw$predictor1 2 数据 框 。head () 函数 返回 raw$predictor1 2 数据 框 的 头 部 数据 。raw$predictor1 2 数据 框 被 当 作 
输入 参数 传 入 : 


> head(raw$predictor1 2) 


结果 如 下 : 


[1] 103. 27068 168. 67332 128.90478 124.96592 84.26295 117.76010 


使 用 rawy$response~raw$predictor1_3 作 为 方程 创建 一 个 典型 的 最 小 二 乘 估计 。|lm () PS2RF22ER ETE EE RE, 
raw$response-raw$predictor1 3 是 方程 。 结 果 存 储 在 fit 数 据 框 : 


> fit = lm(raw$response ~ rawS$predictorl1 3) 
输出 fit 数 据 框 : 

m £16 
结果 如 下 : 

call: 


Im(formula = raw$response ~ raw$predictorl 3) 


coefficients: 
(Intercept) raw$predictorl 3 
6.304595 0. 002496 


绘制 典型 的 最 小 二 乘 估计 方程 。plot () HAEEREN. raw$response-raw$predictor1 3 方程 被 作为 
函数 值 传 入 。 


> plot(raw$response ~ raw$predictorl1 3, pch=16, cex-.4, 
xlab-"Predictor", ylab-"Response", col -z"red", main-z"Simulated Data with 
Slight Curve") 


结果 如 下 : 


仿真 数据 和 拟 合 细 线 
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在 现 有 绘图 中 添加 一 个 直线 函数 : 


> abline(fit) 


结果 如 下 : 


仿真 数据 和 拟 合 细 线 
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在 x 轴 上 拟 合 车 和 速度 的 数值 : 
> x axis <- with(cars, speed) 


在 y 轴 上 拟 合 车 和 速度 的 数值 : 


> y axis «- with(cars, dist) 


设置 平滑 曲线 估计 的 点 数 : 
> eval length = 50 
第 3 步 : 拟 合 平滑 曲线 模型 


两 个 变量 之 间 平 滑 曲 续 拟 合 是 一 种 非 参 数 方法 ， 因 为 我 们 放宽 了 传统 回归 方法 的 绪 性 假设 。 该 拟 合 方式 被 称 为 局 部 回归 ， 
为 在 x 后 的 拟 合 是 对 接近 x 操 的 数据 进行 加 权 拟 合 后 的 结果 。 


loess.smooth () 函数 绘制 散 点 图 ， 并 在 散 点 图 中 添加 平滑 曲线 。x_axis、y_axis 是 提供 给 x 和 y 坐 标 轴 的 参数 。 
evaluationzeval length (如 eval length=50) 代表 用 于 平滑 曲线 的 估计 的 数据 点 数量 。span=0.75 是 平滑 度 参 数 。degree=1 


是 局 部 多 项 式 次 数 : 


> fit loess «- loess.smooth(x axis, y axis, evaluation = eval length, 
family-"gaussian", span-.75, degree-1) 


输出 fit loess 数 据 框 : 


> fit loess 


结果 如 下 : 


η 4.000000 4.428571 4.857143 5.285714 5.714286 6.142857 6.571429 
Kis] 30: 000800 10.428571 10.857143 11.285714 11.714286 12.142857 12.571429 
πε] s DONO 16.428571 16.857143 17.285714 17.714286 18.142857 18.571429 
[43] 22.000000 22.428571 22.857143 23.285714 23.714286 24.142857 24.571429 


$y 

[1] 3.272340 4.649135 6.007926 7.355284 8.697776 10.041974 11.394447 
20.998786 

[15] 22.450966 23.928844 25.355833 26.786293 28.274581 29.857278 31.391655 
43.001795 

[29] 44.220676 45.361214 46.511191 47.778778 49.244460 50.845164 52.509776 
68. 687803 

[43] 71.081492 73.386173 75.774481 78.221236 80.701256 83.189361 85. 660370 
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14.150494 15.567208 16. 984996 18.326847 19 
34.604079 36.239846 37.998521 39.935642 41 


56.025692 58.263629 60.764900 63.413415 66 


在 一 个 或 多 个 数值 预测 器 的 基础 上 使 用 局 部 拟 合 拟 合 多 项 式 曲面 。loess () 函数 用 于 拟 合 多 项 了 式 曲 面 。 


方程 式 。span=0.75 是 平滑 参数 。degree=1 是 局 部 多 项 式 次 数 : 


> fit loess 2 «- loess(y axis ~ x axis, 
degree-1) 


输出 fit loess 2 数据 框 : 


> fit loess 2 


结果 如 下 : 


Call: 


family-z"gaussian", span-.75, 


loess(formula = y axis — x axis, span = 0.75, degree = 1, family = "gaussian") 


Number of observations: 50 


Equivalent Number of Parameters: 3.13 
Residual Standard Error: 15.25 


生成 y 轴 最 小 和 最 大 值 乙 间 的 等 距 序 询 。 


.142857 
.142857 


.142857 


.644429 
. 616790 


- 093080 


y axis-x _ axis 代表 


seq () 函数 接收 length.out=eval_length 参 数 ， 例 如 eval_length=50， 访 值 指明 x 轴 最 大 最 小 值 之 间 的 生成 序列 长 度 : 


> new X axis = seq(min(x axis),max(x axis), 


输出 new x axis 数 据 框 : 


> new x axis 


结果 如 下 : 


length.outzeval length) 


[1] 4.000000 4.428571 4.857143 5.285714 5.714286 6.142857 6.571429 7.000000 7.428571 7.857143 58.285714 58.714286 09.142857 


9. 571429 


[15] 10.000000 10.428571 10.857143 11.285714 11.714286 12.142857 12.571429 13.000000 13.428571 13.857143 14.285714 14.714286 15.142857 


15.571429 


[29] 16.000000 16.428571 16.857143 17.285714 17.714286 18.142857 18.571429 19.000000 19.428571 19.857143 20.285714 20.714286 21.142857 


21.571429 


[43] 22.000000 22.428571 22.857143 23.285714 23.714286 24.142857 24.571429 25.000000 


设 定 fit.loess 模 型 的 置信 和 度 水 平 为 95%. 


> conf int = cbind( 

+ predict(fit loess 2, data.frame(x-new x axis)), 

+ predict(fit loess 2, data.frame(x-new x axis))- 

+ predict(fit loess 2, data.frame(x-new x axis), 
Se-TRUE)S$se.fit*qgnorm(1-.05/2), 

+ predict(fit loess 2, data.frame(x-new x axis))- 

+ predict(fit loess 2, data.frame(x-new x axis), 
Se-TRUE)S$se.fit*qnorm(1-.05/2) 

+ ) 


创建 y axis~Xx_axis 作 为 方程 的 单 规 最 小 二 乘 估计 。Im () 遂 数 被 用 来 拟 合 线性 模型 。y axis~x_axis 是 方程 。 结 果 和 存储 在 
fit_Im 数 据 框 中 : 


> fit lm = lm(y_axis ~ x axis) 


输出 fit Im 数 据 框 : 


> fit lm 


结果 如 下 : 


call: 
Im(formula = y axis ~ x axis) 


coefficients: 
(intercept) X axis 
-17.579 3.932 


PESMI. y axis-poly (x axis, 3) 是 3 个 自由 度 的 多 项 式 函 数 。Im () 函数 用 来 拟 合 线性 模型 。 
y_axis~poly (x axis, 3) 是 方程 。 结 果 和 存储 在 fit_poly 数 据 框 中 : 


> fit poly = lm(y axis ~ poly (x axis,3) ) 


输出 fit_poly 数 据 框 : 


» fit poly 


结果 如 下 : 


call: 
Tm(formula = y axis ~ poly(x axis, 3)) 


Coefficients: 
(intercept) poly(x axis, 3)1 poly(x axis, 3)2 poly(x axis, 3)3 
42.98 145.55 23.00 13.80 


创建 自然 样 条 函数 。y_axis~ns (x axis, 3) 是 3 个 自由 度 的 自然 样 条 函数 。Im () 函数 用 来 拟 合 线性 模型 。 
y_axis~ns (x axis, 3) 是 方程 。 结 果 存 储 在 fit_nat_spline 数 据 框 中 


> fit nat spline = lm(y axis ~ ns(x axis, 3) ) 


输出 fit nat spline 数 据 框 : 


> fit nat spline 


结果 如 下 : 


Call: 
Im(formula = y. axis ~ ns(x axis, 3)) 


coefficients : 
(intercept) ns(x axis, 3)1 ns(x axis, 3)2 ns(x axis, 3)3 
2.594 35.959 96.444 72.986 
平滑 样 条 : 


> fit smth spline «- smooth.spline(y axis ~ x axis, nknots=15) 


输出 fit smth_spline 数 据 框 : 
> fit smth spline 


结果 如 下 : 


Call: 
smooth.spline(x - y axis — x axis, nknots - 15) 


smoothing Parameter spar= 0.7274958 lambda= 0.1118473 (15 iterations) 
Equivalent Degrees of Freedom (Df): 2.632293 

Penalized Criterion: 4189.645 

GCV: 244.1153 


第 4 步 : 绘制 结果 


绘制 模型 : 


> plot(x axis, y axis, xlim-c(min(x axis),max(x axis)), 
ylim=c (min(y axis),max(y axis)), pch-16, 


cex-.5, ylab = "Stopping Distance 
(feet)", xlab- "Speed (MPH)'", 


main-z"Comparison of Models", subz"Splines") 


结果 如 下 : 


模型 比较 
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在 图 中 添加 补充 覃 型 。 绘 制 市 有 置信 区 间 的 LOESs 曲 续 : 


> matplot (new x axis, conf int, lty = c(1,2,2), colzc(1,2,2), type = 
"l", add-T) 


结果 如 下 : 
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绘制 典型 的 最 小 二 乘 估计 。predict () 函数 基于 线性 模型 对 结果 进行 预测 。fit_Im 是 Im 类 的 一 个 对 和 象 : 


> lines(new x axis, predict(fit lm, data.frame(x-new x axis)), 
colz"red", lty=3) 


结果 如 下 : 
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绘制 多 项 式 冰 数 估计 : 


> lines(new x axis, predict(fit poly, data.frame(x-new x axis)), 
colz"blue", lty=4) 


结果 如 下 : 


模型 比较 
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EA TBI ETATE AERA: 


» lines(new x axis, predict(fit nat spline, data.frame(x-new x axis)), 
col-2"green", lty-5) 


结果 如 下 : 


模型 比较 
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绘制 平滑 样 条 : 


> lines(fit smth spline, col="dark grey", lty-6) 


结果 如 下 : 


模型 比较 
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绘制 核 曲线 。 使 用 ksmooth () BR: 


> lines(ksmooth(x axis, y axis, "normal", bandwidth = 5), col = 
'purple', lty=7) 


结果 如 下 : 


模型 比较 
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5.3 ”局 部 回归 : 理解 干旱 警告 和 影响 


旱 是 一 种 目 然 灾害 ， 其 特征 是 降雨 量 低 于 预期 或 正 弟 降 雨量 。 如 果 这 种 情况 持续 时 间 超 过 正音 时 间 ， 将 不 足以 满足 人 类 活 
动 的 需要 ， 并 对 环境 造成 所 害 。 干 时 是 暂时 的 自然 现象 ， 它 的 三 个 主要 特征 是 强度 、 持 续 时 间 和 空间 履 盖 率 。 干 时 预警 系统 有 助 
于 识别 气候 变化 ， 了 解 供水 趋势 ， 并 为 即将 到 来 的 紧急 情况 做 好 准备 。 干 时 预警 可 以 帮助 决策 者 采取 适当 措施 应 对 即将 到 来 的 挑 
战 。 灾 害 过 后 ， 他 们 可 以 衡量 干旱 灾害 影响 的 严重 程度 ， 并 了 解 造 成 干旱 的 根本 原因 ， 以 降低 干旱 灾害 对 特定 地 点 和 特定 人 群 或 
经 济 部 门 造成 的 风险 。 


准备 工作 
让 我 们 从 准备 数据 开始 。 
第 1 步 : 收集 和 摘 述 数据 


dataRetrieval 包 是 一 个 帮助 我 们 从 美国 地 质 调查 局 (US Geological Survey, USGS) 和 美国 环境 保护 署 (US 
Environmental Protection Agency, EPA) 获取 数据 的 函数 集合 。 


以 下 为 实现 细节 。 
第 2 步 : 收集 和 探索 数据 


首先 是 载 入 如 下 库 : 


> library (dataRetrieval) 
» library (dplyr) 


获取 站 点 编号 。 站 点 编号 通常 是 一 个 8 位 数字 ， 用 一 个 字符 串 或 向 量 表示 : 


> siteNumber «- c("01538000") 


获取 参数 编码 : 


> parameterCd «- "00060" 


使 用 站 点 编号 和 参数 编码 从 NWIS 网 络 服务 导入 数据 。 结 果 保 存在 Q_daily 数 据 框 中 : 


> © daily <- readNWISdv(siteNumber, parameterCd) 


输出 Q_daily 数 据 框 。tail () 函数 返回 Q_daily 数 据 框 的 尾部 数据 。Q_daily 数 据 框 作为 一 个 输入 变量 传 入 : 





> tail(Q daily) 


结果 如 下 : 


agency cd site no Date X 00060 00003 x 00060 00003 cd 
35553 U5G5 01538000 2017-01-31 71 P 
35554 USGS 01538000 2017-02-01 66 P 
35555 USGS 01538000 2017-02-02 61 P 
35556 USGS 01538000 2017-02-03 -999999 P Ice 
35557 USGS 01538000 2017-02-04 -999999 P Ice 
35558 USGS 01538000 2017-02-05 -999999 P Ice 


探索 Q_daily 数 据 框 的 内 部 结构 。str () 函数 显示 数据 框 的 内 部 结构 。Q_daily 作 为 





gastr () RAŽI: 


> str(Q_daily) 


结果 如 下 : 


"'data.frame': 35558 obs. of 5 variables: 

$ agency cd : chr "usas" "uscs" "usGS" "USGS" ... 

$ site no : chr "01538000" "01538000" "01538000" "01538000" ... 

$ Date : Date, format: "1919-10-01" "1919-10-02" "1919-10-03" "1919-10-04" 
$ x 00060 00003 : num 25 25 25 25 25 30 30 30 30 30 ... 

$ x 00060 00003 cd: chr "A" "A" "A" "A" 


- attr(*, "ur1")- chr "https: //waterservices. usgs. gov/nwis/dv/?site-01538000&f ormat -waterml,1.1&ParametercCd-00060&St atCd-00003&startDT-1 
851-01-01" 

- attr(*, "siteinfo")-'data.frame': 1 obs. of 13 variables: 

z station nm : chr "wapwallopen Creek near Wapwallopen, PA" 

site no : chr "01538000" 

agency cd : chr “USGS” 

timezoneoffset : chr "-05:00" 

timezoneabbreviation: chr "EST" 

dec lat va : num 41.1 

dec lon va : num -76.1 

srs : chr "EPSG:4326" 

siteTypecd : chr 

huccd : chr "02050107" 

statecd : chr "42" 

countycd : chr 742079" 

network : chr "NwIS" 
attr(*, "variablernfo")- 'data.frame' 1 obs. of 7 variables: 

variablecode : chr "00060" 

var iableName : chr “streamflow, ft&£4179; /s" 

variableDescription: chr "Discharge, cubic feet per second" 

valueType : chr "Derived value" 

unit : chr "ft3/s" 

options : chr "Mean" 

noDataValue : logi NA 

- "attr(*, "disclaimer" jeu: chr "Provisional data are subject to revision. Go to http://waterdata.usgs. gov/nwis/help/?provisional for more 
information.” 

一 . "statisticinfo" )-'data.frame' 1 obs. of 2 variables: 

-$ statisticcd : chr "00003" 
.$ statisticName: chr "Mean" 
- "attr(*, "queryTime")- POSIXct, format: "2017-02-06 23:42:00" 


. . . . . . . . . . . . . . . . 
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重 命名 列 一 一 renameNWISColumns () 函数 将 从 NWIS 获 取 的 列 进行 重 命名 。Q_daily 是 从 NWIS 风 获取 的 日 或 单元 数值 


数据 集 : 
> 0 daily <- renameNWISColumns (Q daily) 
输出 Q_daily 数 据 框 。tail () 函数 返回 Q_daily 数 据 框 的 尾部 数据 。Q_daily 数 据 框 作为 一 个 输入 变量 传 入 : 


> tail(Q daily) 


结果 如 下 : 

agency cd site no Date Flow Flow cd rollMean day.of.year 
35552 UsGs 01538000 2017-01-30 79 P -199942.8 30 
35553 USGS 01538000 2017-01-31 71 P -199941.2 31 
35554 USsGs 01538000 2017-02-01 66 P -199939.9 35 
35555 U5GS5 01538000 2017-02-02 61 P -199938.9 33 
35556 UsGS 01538000 2017-02-03 54 P -199939.4 34 
35557 UsGS 01538000 2017-02-04 65 P -199938.7 35 


从 USGS 文 件 网 站 导入 数据 。readNWlSsite () 函数 使 用 代表 USGS 站 点 编号 的 8 位 数字 的 siteNumber。 结 果 存 储 在 
stationlnfo 数 据 框 中 : 


> stationInfo «- readNWISsite (siteNumber) 


第 3 步 : 计算 移动 均线 


检查 遗漏 的 天 : 

> if(as.numeric(diff(range(Q daily$Date))) != (nrow(Q daily)+1))t 
+ fullDates <- seq(fromzmin(Q daily$Date), 

十 to = max(Q daily$Date), byz"1 day") 

+ fullDates «- data.frame(Date = fullDates, 

+ agency cd = Q daily$agency cd[1], 

十 site no = Q daily$site no[1], 

t stringsAsFactors - FALSE) 

+ Q daily <- full, join(Q daily, fullDates, 

t byzc("Date","agency cd","site no")) %>% 
+ arrange (Date) 

* ἡ 


计算 30 天 移动 平均 线 。filter O 函数 在 一 个 时 间 序 列 数据 集 上 进行 线性 滤波 。sides= 1， 该 过 滤器 系数 指明 只 对 过 去 的 数据 
进行 线性 滤波 : 


> moving avg <- function(x,n-30)(stats::filter(x,rep(1/n,n), sides-1)) 


> Q daily <- Q daily %>% mutate (rollMean = 
as.numeric (moving avg(Flow)), day.of.year = as.numeric(strftime (Date, 
format - "$j"))) 


输出 Q_daily 数 据 框 。tail () 阔 数 返回 Q_daily 数 据 框 的 尾部 数据 。Q_daily 数 据 框 作为 一 个 输入 变量 传 入 : 
> tail(Q daily) 


结果 如 下 : 


agency cd site no Date Flow Flow cd rollMean day.of.year 


35552 U5G5 01538000 2017-01-30 79 P -199942.8 

35553 USGS 01538000 2017-01-31 71 P -199941.2 31 
35554 usGs 01538000 2017-02-01 66 P -199939.9 32 
35555 USGS 01538000 2017-02-02 61 P -199938.9 33 
35556 usGs 01538000 2017-02-03 54 P -199939.4 34 
35557 U5G5 01538000 2017-02-04 65 P -199938.7 35 


第 4 步 : 计算 百 分 位 


计算 历史 百 分 位 数 。 使 用 不 同 的 概率 计算 相应 的 分 位 数 。 然 后 使 用 summarize () 遂 数 将 数据 框 整合 成 单一 行 。 最 后 ， 使 
用 group_by () 水 数 将 结果 转换 并 组 合成 一 个 表 : 


> Q summary <- Q daily %>% 

十 group by(day.of.year) $»$ 

t summarize(p75 - quantile(rollMean, probs - .75, na.rm - TRUE), 
t p25 = quantile(rollMean, probs = .25, na.rm = TRUE), 
t p10 = quantile(rollMean, probs = 0.1, na.rm = TRUE), 
t p05 = quantile(rollMean, probs = 0.05, na.rm = TRUE), 
+ p00 = quantile (rollMean, probs ΞΟ, na.rm = TRUE)) 


从 系统 中 获取 当前 年 份 : 


> current year «- as.numeric(strftime(Sys.Date(), format = "%Y")) 


> summary.O0 <- Q summary $»$ mutate (Date = as.Date(day.of.year - 1, 
origin = Paste0 (current year-2,"-01-01")), day.of.year = day.of.year - 365) 


> summary.1 <- Q summary $»$ mutate (Date = as.Date(day.of.year - 1, 
origin = Paste0 (current year-1,"-01-01"))) 


» summary.2 «- Q summary $»$ mutate(Date - as.Date(day.of.year - 1, 
origin = pasteO (current year,"-01-01")), day.of.year = day.of.year + 365) 


将 多 个 数据 框 整合 在 一 起 : 


> Q summary <- bind_rows (summary.0, summary.1, summary.2] 


输出 Q_ summary 数 据 框 : 


> Q summary 


结果 如 下 : 
# A tibble: 1,098 x 7 
day.of.year p75 p25 p10 ΡΌ5 poo Date 
«db 1> «db 1> «db 1> db 1 «db 1- «db 1 <date> 
1 -364 101.69167 40.11667 21.07333 14.30450 -233307.0 2015-01-01 
2 -363 105.92500 41.60833 22.66567 16.89083 -233307.2 2015-01-02 
3 -362 106.45000 41.31667 23.32900 17.16283 -233307.0 2015-01-03 
4 -361 104.86667 40.76667 23.79767 17.22783 -233305.7 2015-01-04 
5 -360 103.88333 41.01667 23.59900 17.33067 -233305.1 2015-01-05 
6 -359 101.73333 41.61417 23.66900 17.77900 -233305.5 2015-01-06 
7 -358 99.96667 42.16417 23.86900 19.86667 -233305.8 2015-01-07 
8 -357 101.54167 42.05750 23.82867 20.04667 -266640.2 2015-01-08 
9 -356 94.99167 41.66667 24.42333 20.98333 -299974.5 2015-01-09 
10 -355 92.70000 41.41667 24.69333 20.83167 -333308.6 2015-01-10 
# ... with 1,088 more rows 


> smooth.span <- 0.3 


基于 线性 模型 进行 预测 ， 并 拟 合 多 项 式 曲 面 。loess () 函数 能 够 拟 合 多 项 式 曲面 。p75~day.of.year 代 表 方 
程 ，span=smooth.span (如 smooth.span=0.3) 控制 平滑 度 : 


> Q summary$sm.75 «- predict (loess (p75~day.of.year, data = Q summary, 
span = smooth.span)) 


输出 Q summary$sm.75 数 据 框 : 
> head(Q summary$sm.75) 
结果 如 下 : 


[1] 80.59694 81.44816 82.29218 83.12881 83.95787 84.77917 


> Q summary$sm.25 «- predict(loess(p25-day.of.year, data = Q summary, 
span = smooth.span)) 


输出 Q summary$sm.25 数 据 框 : 
> head (summaryQ$ sm .25) 
结果 如 下 : 


[1] 36.16151 36.16151 36.58664 37.00671 37.42077 37.82784 


> Q summary$sm.10 <- predict (loess (p10~day.of.year, data = Q summary, 
span = smooth. span)) 


输出 Q summary$sm.10 数 据 框 : 


> head(summaryQ$sm.10) 


结果 如 下 : 


[1] 16. 23024 16.23024 16.48055 16.73002 16.97826 17.22487 


> Q summary$sm.00 <- predict (loess (p00~day.of.year, data = Q summary, 
span = smooth. span)) 


输出 Q_ summary$sm.05 数 据 框 : 


> head(summaryQS$sm.05) 


结果 如 下 : 
[1] 16.23024 16.23024 16.48055 16.73002 16.97826 17.22487 


> Q summary$sm.00 <- predict (loess (p00~day.of.year, data = Q summary, 
span = smooth. span) ) 


输出 Q summary$sm.00 数 据 框 : 


> head(summaryQ$sm.00) 


结果 如 下 : 


[1] -109716.7 -109716.7 -110200.7 -110650.7 -111063.8 -111437.1 

» Q summary «- select(Q summary, Date, day.of.year, sm.75, sm.25, 
sm.10, sm.05, sm.00) %>% filter (Date >= 
as .Date (Paste0 (current year-1,"-01-01"))) 


输出 Q summary 数 据 框 : 


> Q summary 


结果 如 下 : 
# A tibble: 733 x 7 
Date day.of.year sm.75 sm.25 sm.10 sm. 05 sm. 00 
«date» «db1- «db1- «db1- «db1- «db1- «db1- 
1 2016-01-01 1 90.99353 36.16151 22.41312 16.23024 -109716.7 
2 2016-01-01 1 90.99353 36.16151 22.4131? 16.23024 -109716.7 
3 2016-01-02 2 91.56954 36.58664 22.72999 16.48055 -110200.7 
4 2016-01-03 3 92.13778 37.00671 23.04434 16.73002 -110650.7 
5 2016-01-04 4 92.69719 37.42077 23.35553 16.97826 -111063.8 
6 2016-01-05 5 93.24672 37.82784 23.66293 17.22487 -111437.1 
7 2016-01-06 6 93.78531 38.22699 23.96590 17.46943 -111767.7 
8 2016-01-07 7 94.31193 38.61726 24.26381 17.71154 -112052.9 
9 2016-01-08 8 94.82552 38.99769 24.55602 17.95079 -112289.7 
10 2016-01-09 9 95.32503 39. 36733 24.84190 18.18678 -112475.3 
# ... with 723 more rows 


> latest.years <- Q daily %>% filter(Date >= 
as.Date(pasteO (current year-1,"-01-01"))) %>% mutate(day.of.year = 
1:nrow(.)) 


第 5 步 : 绘制 结果 


绘制 数据 : 


> title.text <- pasteO(stationInfo$station nm,"n", "Provisional Data - 
Subject to changen", "Record Start - ", min(Q daily$Date), " Number of 
years = ", as.integer (as.numeric(difftime(timel = max(Q daily$Date), time2 
= min(Q daily$Date), units = "weeks"))/52.25), "nDate of plot = 
",Sys.Date(), " Drainage Area = ",stationInfo$drain area va, "mi^2") 


> mid.month.days «- c(15, 45, 74, 105, 135, 166, 196, 227, 258, 288, 
319, 349) 


> month I letters <— σ ο " "pP" ; "M" ; "AU ; "M" ; "g" ; "J" ; "A" 7 "S" ; "O F "N" 7 ος 


> start month.days <= ο, 32, 61, 92, 121, 152, 182, 214, 245, 274, 
4305, 335) 


> label.text <- c("Normal"," 'DroughtWatch"," "DroughtWarning", "Drought 
Emergency") 


> yearl summary <- data.frame(Q summary[2:366,]) 


> head(vearl summarv) 


结果 如 下 : 


Date day.of.year sm.75 sm.25 sm.10 sm. 05 sm. 00 
1 2016-01-01 1 90.99353 36.16151 22.41312 16.23024 -109716.7 
2 2016-01-02 2 91.56954 36.58664 22.72999 16.48055 -110200.7 
3 2016-01-03 3 92.13778 37.00671 23.04434 16.73002 -110650.7 
4 2016-01-04 4 92.69719 37.42077 23.35553 16.97826 -111063.8 
5 2016-01-05 5 93.24672 37.82784 23.66293 17.22487 -111437.1 
6 2016-01-06 6 93.78531 38.22699 23.96590 17.46943 -111767.7 
> year2 summary «- data.frame(Q summary[367:733,]) 
» head(year2 summary) 
结果 如 下 : 
Date day.of.year sm.75 sm.25 sm.10 sm. 05 sm. 00 
1 2016-12-31 366 90.55267 35.63442 22.02318 15.95450 -109125. 5 
2 2017-01-01 366 90.55267 35.63442 22.02318 15.95450 -109125.5 
3 2017-01-02 367 91.13212 36.10354 22.39240 16.25584 -109351.1 
4 2017-01-03 368 91.71522 36.58013 22.76842 16.56302 -109564.3 
5 2017-01-04 369 92.30089 37.06284 23.15014 16.87519 -109764.4 
6 2017-01-05 370 92.88805 37.55033 23.53646 17.19149 -109951.0 
> simple.plot «- ggplot (data = Q_summary, aes(x = day.of.year)) + 
+ geom ribbon(aes(ymin = sm.25, ymax = sm.75, fill = "Normal")) + 
+ geom ribbon(aes(ymin = sm.10, ymax = sm.25, fill = 
"Drought Watch")) 十 
+ geom ribbon(aes(ymin = sm.05, ymax = sm.10, fill = "Drought 
Warning")) 二 
+ geom ribbon(aes(ymin = sm.00, ymax = sm.05, fill = "Drought 


Emergency")) 十 
+ scale y 1οσ10 (limits = 
+ geom line (data 
"30-Day Mean"),size-2) + 


c(1,1000)) + 
= latest.years, 


aes (x=day .of .year, 


y=rollMean, 


+ geom vline(xintercept = 365) 


» simple.plot 


结果 如 下 : 
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本 章 将 涵盖 如 下 内 容 : 

` 决策 树 学 习 : 对 胸痛 患者 的 预先 医疗 护理 指示 
` 决策 树 学 习 : 基于 收入 的 房地产 价值 分 布 

` 决策 树 学 习 : 预测 股票 走势 方向 

. 朴素 贝 叶 斯 : 预测 股票 走势 方向 

- 随机 森林 : 货币 交易 策略 

- 支持 向 量 机 : 货币 交易 策略 


- 随机 梯度 下 降 : 成 人 收入 


决策 树 学 习 : 作为 分 类 和 问题 预测 的 常用 工具 ， 决 策 树 是 一 种 递归 地 划分 实例 空间 或 变量 集 的 分 类 器 。 决 策 树 表示 为 树 结 
构 ， 其 刁 点 分 为 两 类 : 叶 布 点 或 决策 节点 。 叶 节点 用 于 保存 目标 属性 的 值 ， 决 策 节操 则 指定 在 单个 属性 - 值 上 实现 的 规则 。 决 策 
节操 根据 输入 属性 - 值 的 特定 离散 立 数 将 实例 空间 分 割 成 两 个 或 多 个 子 空间 。 每 个 测试 考虑 单个 属性 ， 使 得 实例 空间 根据 属性 的 
值 进行 分 区 。 例 如 ， 在 数值 属性 的 情况 下 ， 条 件 残 指 的 是 一 个 范围 。 在 决策 节点 上 实现 规则 后 ， 对 应 的 子 树 丈 是 决策 结果 。 每 个 
叶 古 点 保存 一 个 概率 向 量 ,， 访 向量 指示 了 目标 属性 具有 特定 值 的 概率 。 根 据 沿路 径 测试 的 结果 ， 由 树 的 根 书 点 到 叶 世 点 游历 ， 从 
而 对 实例 进行 分 类 。 


使 用 决策 树 挖掘 数据 的 核心 需求 如 下 。 
ΕΕΒΕ: 目标 可 以 描述 为 一 个 特性 或 属性 的 固定 集合 。 
- 预 设 类 别 : 待 分 配 类 别 的 示例 必须 是 监督 数据 。 


- 足够 的 数据 : 使 用 多 个 训练 样本 。 


的 存在 与 其 他 特征 的 存在 无 天。 朴素 贝 叶 斯 是 一 种 强大 且 高 效 的 算法 。 贝 叶 斯 分 类 器 可 以 预测 类 成 员 概率 ， 例 如 给 定 元 组 属于 特 


定 类 的 概率 。 贝 叶 斯 信念 网 络 是 一 个 联合 条 件 概率 分 布 。 它 允 计 在 变量 子 集 之 间 定 义 类 条 件 独 立 性 。 它 提供 了 可 供 学 习 的 因果 关 
系 的 图 形 模型 。 


FRUITS: 朴 泰 贝 叶 斯 是 一 种 监督 学 习 的 方法 。 作 为 一 种 基于 贝 叶 斯 理论 的 线性 分 类 器 ， 其 理论 据 出 ， 某 一 类 的 特定 特征 


随机 和 森林: 随机 森林 是 对 数据 结构 提供 预测 的 决 案 树 集合 。 它 们 是 一 种 在 明智 的 随机 化 中 汇集 多 个 决 案 树 能 力 ， 以 及 整体 学 
习 以 闫 生 预 测 模型 的 工具 。 它 们 为 每 个 记录 提供 可 变 排 名 、 缺 失 值 、 分 段 和 报告 ， 以 确保 深入 理解 数据 。 每 棵 树 建 成 后 ， 所 有 的 
数据 都 沿 树 目 上 而 下 运行 。 对 于 每 一 对 情况 ， 均 需 对 邻 域 进行 计算 。 如 果 两 种 情况 占用 同一 终端 匡 点 ， 则 其 邻 域 增加 一 个 。 在 运 
行 结束 时 ， 将 结果 除 以 树 的 数量 进行 归 一 人 化。 近似值 用 于 奉 换 丢失 的 数据 ， 定 位 异 剃 值 ， 并 有 助 于 对 数据 的 低 维 度 理 解 。 作 为 外 


包 数 据 ， 训 练 数据 用 于 评估 分 类 误差 并 计算 变量 的 重要 性 。 


随机 和 森林 运行 在 大 型 数据 库 上 ， 可 以 非常 有 效 地 闫 生 准 确 的 结果 。 它 们 可 以 在 不 需要 删除 操作 的 情况 下 人 处理 多 个 变量 ， 并 通 
过 估计 变量 的 重要 性 来 解决 分 类 问题 。 在 森林 构建 的 过 程 中 ， 它 们 产生 了 对 泛 化 误 磊 的 内 部 无 偏 估计 。 随 机 森林 是 估计 丢失 数据 
的 有 效 方法 ,特别 是 在 大 部 分 数据 丢失 时 依然 能 保持 很 高 的 准确 性 。 


sess. (SVM) : 机 器 学 习 算 法 解决 学 习 问 题 需要 使 用 正确 的 特征 集 。SVM 利 用 ( 非 线 性 ) BABJBSZXO, Ti) 
的 数据 转换 为 特征 空间 中 的 数据 ， 使 得 问题 线性 可 分 离 。SVM 查 找 最 佳 分 离 超 平面 并 通过 -1 映射 回 输入 空间 。 在 所 有 可 能 的 
超 平 面 中 ， 选 择 距 离 最 接近 的 数据 点 ( 边 距 ) 尽 可 能 大 的 超 平 面 。 


6.2 RRF: 对 胸痛 患者 的 预先 医疗 护理 措 示 


预先 医疗 护理 指示 的 文档 解释 说 明了 未 来 对 患者 在 各 种 医疗 状况 下 的 健康 护理 ， 引 导 患 者 在 内 急 情况 下 或 根据 需要 做 出 正确 
的 决定 ， 帮 助 患者 了 解 其 医疗 护理 决定 和 指示 的 性 质 和 后 果 ， 上 自由 且 上 自愿 地 做 出 这 些 决定 ， 并 以 某 种 万 式 传达 决定 。 


准备 工作 
我 们 使 用 心脏 病 患者 的 数据 集 来 搭建 决策 树 分 类 。 
第 1 步 : 收集 和 描述 数据 
选用 的 数据 集 Heart.csv 是 一 种 可 访问 的 CSV 格 式 标准 数据 集 ， 存 储 303 行 数据 和 15 个 变量 ， 其 中 数值 型 变量 包括 : 
- Age 
- Sex 
- RestBP 
- Chol 
- Fbs 
- RestECG 
- MaxHR 
- ExAng 
- Oldpeak 
- Slope 
- Ca 
非 数值 型 变量 包括 : 


* ChestPain 


: Thal 


: AHD 


具体 实施 步骤 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 
首先 需要 加 载 以 下 软件 包 : 


install.packages ("tree") 
install.packages ("caret") 
install.packages ("e1071") 
library (tree) 
library (caret) 


V V V V V 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.3.0 (2016-05-03) 。 


现在 开始 探索 数据 并 理解 参数 之 间 的 关系 。 导 入 Heart.csv 数 据 集 并 保存 为 AHD data 数 据 框 : 


> AHD data «- read.csv("d:/Heart.csv", header = TRUE) 


探索 AHD_data 数 据 框 的 内 部 结构 : fERdeSEXStr () 探索 作为 R 对 象 的 AHD_data 数 据 框 的 内 部 结构 。 


> Str(AHD data) 


结果 如 下 : 
data.frame': 303 obs. of 15 variables: 
$ x : int 123456780910... 
$ Age : int 63 67 67 37 41 56 62 57 63 53 ... 
$ sex : imt 1111010011... 
$ chestPain: Factor w/ 4 levels “asymptomatic ,--: 4112331111 ... 
$ RestBP : int 145 160 120 130 130 120 140 120 130 140 ... 
$ chol : int 233 286 229 250 204 236 268 354 254 203 ... 
$ Fbs : int 1000000001... 
$ RestECG : int 2220202022... 
$ MaxHR : int 150 108 129 187 172 178 160 163 147 155 ... 
$ ExAng : int 0110000101 ... 
$ oldpeak : num 2.3 1.5 2.6 3.5 1.4 0.8 3.6 0.6 1.4 3.1 ... 
$ slope : int 32231131243... 
$ Ca : int 03200020410... 
$ Thal : Factor WA 3 levels "fixed","normal",..: 12322222343... 
$ AHD : Factor w/ 2 levels "No","ves": 1221112122... 


输出 AHD _data 数 据 框 。 使 用 函数 head () 返回 AHD _data 数 据 框 的 头 部 数据 ，AHD _data 作 为 函数 的 输入 参数 传递 


> head(AHD data) 


结果 如 下 : 

Χ Age Sex chestPain RestBP chol Fbs RestECG MaxHR ExAng kaku" slope ca Thal AHD 
11 63 1 typical 145 233 1 2 150 τ. 3 0 fixed No 
22 67 1 asymptomatic 160 286 0 2 108 l rs 2 3 normal ves 
33 67 1 asymptomatic 120 229 ο 2 129 1 2.6 2 2 reversable ves 
44 37 1  nonanginal 130 250 ο 0 187 0 3.5 3 0 normal No 
55 41 O  nontypical 130 204 ο 2 172 0 1.4 1 0 normal No 
66 56 1  nontypical 120 236 0 0 178 0 0.8 1 0 normal Νο 


探索 AHD data 数 据 框 的 维度 。 使 用 dim () 函数 返回 AHD data 数 据 框 的 维度 ，AHD data 作 为 函数 的 输入 参数 。 返 回 结 
果 清 楚 地 显示 数据 框 有 303 行 和 15 列 : 


> dim(AHD data) 


结果 如 下 : 
[1] 303 15 | 
第 3 步 : 准备 数据 
需要 准备 的 数据 分 为 两 部 分 : 一 部 分 为 训练 数据 ， 用 于 构建 模型 ; 另 一 部 分 为 测试 数据 ， 用 于 测试 已 构建 的 模型 。 


PE createDataPartition () 用 于 创建 数据 分 块 ，AHD_data 为 函数 的 输入 参数 。 函 数 采 用 随机 抽样 ， 参 数 p 用 于 训 | 练 和 构 
建 模 型 的 数据 比例 ， 本 例 中 p=0.5。 也 殊 是 说 ,分 别 有 50% 的 数据 用 于 训练 和 构建 模型 。 参 数 list='False' 避 免 返 回 结 果 为 数据 列 
表 ， 而 是 存储 在 数据 框 split 中 : 


> split <- createDataPartition(y-AHD data$AHD, p = 0.5, list=FALSE) 


调用 数据 框 split 即 可 查看 训练 数据 集 : 


> split 
结果 如 下 : 

Resamp 1el 
[1,] 1 
[2,] 3 
[3] 4 
[4 ] 5 
[5,] 7 
[6,] 8 
EF 13 
[8,] 18 
[9,] 19 
[10, ] 21 
[11,] 23 
[12,] 24 
[13,] 26 
[11 ] 27 
[15,] 28 
[16,] 29 
[17,] 30 
[18,] 31 
[19,] 32 
[201 33 
[21, ] 34 
[22,] 37 
[23,] 38 
[24,] 40 
[25,1] 41 
[26, ] 43 
[27 ,] 44 
[28 ] 45 
[29 ] 48 


下 面 创建 训练 数据 。 使 用 split 数 据 框 来 创建 训练 数据 并 存储 在 train 数 据 框 中 : 


> train «- AHD data[split,] 


18, 





输出 训练 数据 框 : 
> train 

结果 如 下 : 

X Age Sex 
1 1 63 1 
3 3 67 1 
4 4 37 1 
5 5 41 0 
7 7 62 0 
8 8 57 0 
13 13 56 1 
18 18 54 1 
19 19 48 0 
21 21 64 1 
23 23 58 1 
24 24 58 1 
26 26 50 O 
27 27 58 ο 
28 28 66 0 
20 29 43 1 
30 30 40 1 
31 31 69 0 
32 32 60 1 
33 33 64 1 
34 34 59 1 
37 37 43 1 
38 38 57 1 
40 40 σι 
41 41 65 
43 43 71 
44 44 59 
45 45 61 


下 面 创建 测试 数据 。 同 样 利 用 split 数 据 框 来 建立 测试 数据 。 
练 数据 的 补 集 。 使 用 test 数 据 框 来 存储 测试 数据 : 





即 取 训 


> test «- ΔΗΡ data[-split,] 


输出 测试 数据 框 : 


> test 


结果 如 下 : 


1 


0 
1 


chestPain RestBP Chol Fbs RestECG MaxHR ExAng Oldpeak Slope Ca 


typical 
asymptomatic 
nonanginal 
nontypical 
asymptomatic 
asymptomatic 
nonanginal 
asymptomatic 
nonanginal 
typical 
nontypi cal 
nonangi nal 
nonanginal 
nonangi na] 
typical 
asymptomatic 
asymptomatic 
typical 
asymptomatic 
nonanginal 
asymptomatic 
asymptomatic 
asymptomatic 


nonanginal 
0 asymptomatic 
nontypical 
nonanginal 
0 asymptomatic 


145 
120 
130 
130 
140 
120 
130 
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οσο ο 


2.3 
2.6 
3.5 
1.4 
3.6 
0.6 
0.6 
1.2 
0.2 
1.8 
1.8 
3.2 
1.6 
0.0 
2.6 
21.3 
2.0 
1.8 
1.4 
0.0 
0.5 
"P 
0.6 


NJ NJ NJ S I END FS UJ FS ND ES NI ND E ES ND FS UU E UJ NJ UJ 


[|oodcONuNNuNODOOOONOOOOHONOO)ON O 


B RPR NN 


Thal 
fixed 
reversable 
normal 
normal 
normal 
normal 
fixed 
normal 
normal 
normal 
normal 
reversable 
normal 
normal 
normal 
normal 
reversable 
normal 
reversable 
normal 
reversable 
reversable 
fixed 


e ON ut 


normal 
reversable ves 
normal 
normal 
normal ves 


"代表 获得 所 有 split 数 据 框 里 面 未 用 于 计 


NO 


NO 
NO 





练 数据 的 数 


X Age Sex chestPain RestBP Chol Fbs RestECG MaxHR ExAng Oldpeak slope ca Thal AHD 


2 2 67 1 asymptomatic 160 286 0 2 108 1 1.5 2 3 normal ves 
6 6 56 1  nontypical 120 236 0 0 178 0 0.8 1 0 normal 

9 9 63 1 asymptomatic 130 254 ο 2 147 0 1.4 2 1 reversable ves 
10 10 53 1 asymptomatic 140 203 1 2 155 1 3.1 3 O0 reversable ves 
11 11 57 1 asymptomatic 140 192 0 0 148 0 0.4 2 0 fixed No 
12 12 56 Ὁ  nontypical 140 294 ο 2 153 0 1.3 2 0 normal No 
14 14 44 1 nontypical 120 263 0 0 173 0 0.0 1 O0 reversable Νο 
15 15 52 1  nonanginal 172 199 1 0 162 0 0.5 1 O0 reversable Νο 
16 16 57 1  nonanginal 150 168 0 0 1⁄4 0 1.6 1 O normal No 
17 17 48 1 nontypical 110 229 0 0 168 0 1.0 3 0 reversable ves 
20 20 49 1 nontypical 130 266 0 0 1/1 0 0.6 1 ο normal No 
22 22 58 O typical 150 283 1 2 162 0 1.0 1 0 normal No 
25 25 60 1 asymptomatic 130 206 ο 2 132 1 2.4 2 2 reversable ves 
35 35 44 1  nonanginal 130 233 0 0 179 1 0.4 1 O normal No 
36 36 42 1 asymptomatic 140 226 0 0 178 0 0.0 1 O normal No 
33 39 55 1 asymptomatic 132 353 0 0 132 1 1.2 2 1 reversable Yes 
42 42 40 1 typical 140 199 0 0 178 1 1.4 1 0 reversable No 
46 46 58 1 nonanginal 112 230 ο 2 165 0 2.5 2 1 reversable ves 
47 47 51 1  nonanginal 110 175 0 0 123 0 0.6 1 0 normal No 
50 5ο 53 1  nonanginal 130 197 1 2 152 0 1.42 3 0 normal No 
55 55 60 1 asymptomatic 130 253 0 0 144 1 1.4 1 1 reversable ves 
56 56 54 1 asymptomatic 124 266 0 2 109 1 2.2 2 1 reversable Yes 
60 60 51 1 typical 125 213 0 2 125 1 1.4 1 1 normal No 
61 61 51 0 asymptomatic 130 305 ο 0 142 1 1.2 2 0 reversable ves 
65 65 54 1 asymptomatic 120 188 ο 0 113 0 1.4 2 1 reversable ves 
66 66 60 1 asymptomatic 145 282 0 2 142 1 2.8 2 2 reversable Yes 
71 71 65 O  nonanginal 155 269 O 0 148 0 0.8 1 O normal No 


第 4 步 : 训练 模型 


` 
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现在 使 用 训 














。 使 用 决策 树 对 比 查 看 数字 响应 和 摘 述 竺 变量 的 天 系 ， 并 将 数据 分 为 寿 干 组 。 





νι 
EINS 


R 语 言 中 实现 分 类 树 的 国 数 为 tree () ， 通 过 二 元 递归 分 类 的 方法 生出 树 。 基 于 训 
将 结果 存储 在 trees 数 据 框 中 : 











， 使 用 AHD 字 段 构建 分 类 树 ， 并 


AJ CA 
一 人 \ 刀 


> trees <- tree(AHD ~., train) 


使 用 函数 plot () 可 以 将 生成 的 数据 框 trees 显 示 为 图 像 ，trees 作 为 函数 的 输入 参数 : 


> plot(trees) 


结果 如 下 : 


使 用 水 数 cv.tree () ， 通 过 运行 交叉 验证 实验 来 查找 偏差 和 错误 分 类 的 数量 。 数 据 框 trees 为 水 数 的 输入 参 
数 ，FUN=prune.misclass 代 表 通 过 违 归 地 截取 最 不 重要 的 分 块 来 获得 所 提供 的 数据 框 trees 的 子 树 的 诗 套 序列 。 输 出 结果 存储 
于 cv.trees 数 据 框 中 : 


> cv.trees <- cv.tree(trees, FUN-prune.misclass) 


输出 数据 框 cv.trees 的 结果 : 


> cv.trees 


$dev 字 段 给 出 每 个 K 的 偏差 。 
结果 如 下 : 


$size 
[1] 16 1210 9 8 5 2 1 


$dev 
[1] 36 36 35 39 46 50 52 71 


$k 
[1] -Inf 40.000000 40.500000 1.000000 2.000000 2.666667 3.666667 30.000000 


$method 
[1] "misclass" 


attr(,"class") 
[1] "prune" “tree. sequence” 


利用 函数 plot () 来 显示 数据 框 cv.trees。$dev 值 位 于 y 轴 上 (AM) ，$k 值 位 于 顶部 ，$size 值 位 于 x 轴 上 。 


可 以 看 出 ， 当 $size=1 时 ，$k=30.000000，$dev=71。 使 用 以 下 命令 显示 数据 框 cv.trees: 
> plot(cv.trees) 


结果 如 下 : 


30.0 3.7 27 20 10 05 00 -Inf 


70 


65 


60 


55 


50 


45 


40 


35 


size 


HH 


第 5 步 : 改进 模型 


下 面 通过 以 最 低 偏差 分 裂 树 的 方式 来 改进 模型 。 调 用 prune.misclass () 函数 来 分 割 树 。 (前 面 提 到 ，prune.misclass 函 数 
通过 递归 地 截取 最 不 重要 的 分 块 来 获得 提供 的 数据 框 树 的 子 树 的 坐 套 序 列 。) 并 将 结果 存储 在 prune.trees 数 据 框 中 。best=4 表 
示 要 返回 的 成 本 复杂 度 序 列 中 特定 子 树 的 大 小 CREER ERE) : 


` 


> prune.trees <- prune.misclass (trees, best-4) 


使 用 plot () 团 数 来 显示 prune.trees: 


> plot(prune.trees) 


结果 如 下 : 














为 prune.trees 添 加 文本 : 


> text (prune.trees, pretty=0) 


结果 如 下 : 


ERS < 53.5 


胸部 疼痛 : JC 228, JERA 


X<38 





No 


使 用 predict () 函数 基于 线性 模型 对 象 来 预测 值 ，prune.trees 作 为 函数 的 输入 参数 。 数 据 对 象 test 用 于 查找 预测 的 变量 。 
负数 的 输出 结果 将 人 存储 在 tree.pred 数 据 框 中 : 


> tree.pred <- predict(prune.trees, test, type-'class') 


显示 变量 test.pred 的 值 : 


> tree.pred 


结果 如 下 : 


[1] Νο No Yes Yes Yes ΝΟ Yes Yes ΝΟ Yes ΝΟ ΝΟ Yes ΝΟ ΝΟ Yes Yes Yes NO ΝΟ Yes Yes NO Yes Yes Yes 
NO Yes Yes Yes 

[31] NO Yes No Yes ΝΟ NO NO Yes Yes Yes NO NO Yes NO NO No Yes ΝΟ Yes Yes Yes Yes Yes Yes NO ΝΟ 
Yes Yes Yes Yes 

[61] No Yes No Yes Yes Yes Yes Yes ΝΟ ΝΟ Yes ΝΟ 
Yes Yes NO Yes 

[91] ves Yes No Yes NO NO Yes Yes Yes Yes NO No 
NO No Yes Yes 

[121] No ves ves ves Yes NO Yes Yes NO Yes NO Yes Yes NO NO Yes Yes Yes NO Yes Yes NO Yes NO Yes Yes 
NO Yes Yes Yes 

[151] No 
Levels: No Yes 


Yes Yes Yes Yes Yes Yes NO No Yes Yes Yes Yes Yes Yes 


NO Yes Yes NO NO NO NO Yes NO Yes NO ΝΟ Yes ΝΟ 


下 面 归纳 模型 的 结果 。 逊 数 confusionMatrix () 用 于 计算 观察 和 预测 的 分 类 的 交叉 定 标 ， 在 这 里 tree.pred 作 为 被 预测 的 
DRAFTER: 


> confusionMatrix(tree.pred, test$AHD) 


结果 如 下 : 


confusion Matrix and statistics 


Reference 
Prediction No Yes 
No 54 6 
Yes 28 63 


Accuracy : 0.7748 


95% CI : (0.6998, 0.8387) 
No Information Rate : 0.543 
P-Value [Acc > NIR] : 2.86e-09 


Kappa : 0.5575 
Mcnemar's Test P-value : 0.0003164 

Sensitivity : 0.6585 

specificity : 0.9130 

Pos Pred value : 0.9000 

Neg Pred value : 0.6923 

Prevalence : 0.5430 

Detection Rate : 0.3576 

Detection Prevalence : 0.3974 

Balanced Accuracy : 0.7858 

'Positive' class : No 


6.3 ”决策 树 学 习 : 基于 收入 的 房地产 价值 分 布 





作为 一 种 资产 类 别 ， 房 产 收入 已 经 成 为 由 房地产 提供 的 有 吸引 力 的 长 期 总 收益 的 重要 组 成 部 分 。 房 地 产 投资 产生 的 年 收入 是 
& 票 的 2.5 倍 以 上 ， 只 落后 于 债券 投资 520 个 基点 。 房 地 产 经 钊 由 租户 文 付 的 租金 提供 稳定 的 收入 来 源 。 


准备 工作 


我 们 使 用 房地产 的 数据 集 来 搭建 决策 树 分 类 。 


第 1 步 : 收集 和 摘 述 数据 
使 用 的 数据 集 RealEstate.txt 为 可 访问 的 标准 TXT 格式 数据 集 ， 包 含 20640 行 数据 和 以 下 9 种 数值 型 变量 : 
: MedianHouseValue 

: MedianIncome 

: MedianHouseA ge 

: TotalRooms 

: TotalBedtooms 

: Population 

: Households 

: Latitude 


: Longitude 


以 下 为 实现 细节 。 

第 2 步 : 探索 数据 

首先 需要 加 载 以 下 软件 包 : 

> install.packages ("tree") 

版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.3.0 (2016-05-03) ο 

现在 开始 探索 数据 并 理解 参数 之 间 的 关系 。 导 入 RealEstate.txt 数 据 集 并 保存 为 realEstate 数 据 框 : 


> realEstate «- read.table("d:/RealEstate.txt", header=TRUE) 


探索 realEstate 数 据 框 的 维度 。 使 用 dim () E&gZNDE[n]realEstateZidEfEB ERE, realEstatef/E7JEFZXBJs8N ES, RAR 
清楚 地 显示 数据 框 有 20640 行 和 9 列 |: 


> dim(realEstate) 


结果 如 下 : 


[1] 20640 9 


探索 realEstate 数 据 框 的 内 部 结构 : 使 用 函数 str () 探索 作为 R 对 象 的 rea|Estate 数 据 框 的 内 部 结构 ，realEstate 作 为 国 数 的 


输入 参数 : 


> str(realEstate) 


结果 如 下 : 


"'data.frame': 


20640 obs. of 9 variables: 
452600 358500 352100 341300 342200 ... 


-122 ... 


$ MedianHousevalue: num 

$ Medianincome : num 8.33 8.3 7.26 5.64 3.85 ... 

$ MedianHouseAge : num 41 21 52 52 52 52 52 52 42 52 ... 
$ TotalRooms : num 880 7099 1467 1274 16?7 ... 

$ TotalBedrooms : num 129 1106 190 235 280 ... 

$ Population : num 322 2401 496 558 565 ... 

$ Households : num 126 1138 177 219 259 ... 

$ Latitude : num 37.9 37.9 37.9 37.9 37.9 ... 

$ Longitude : num -122 -122 -122 -122 

输出 realEstate 数 据 框 。 使 用 函数 head () i 


> head(realEstate) 


结果 如 下 : 


返回 realEstate 数 据 框 的 头 部 数据 ， 


realEstate 作 为 负数 的 输入 参数 : 


MedianHousevalue MedianIncome MedianHouseAge TotalRooms TotalBedrooms Population Households Latitude Longitude 


Ce un d uN HH 


452600 
358500 
352100 
341300 
342200 
269700 


8.3252 
8. 3014 
-2574 
- 6431 
- 8462 
0368 


T+ un s 


输出 realEstate 数 据 框 的 概要 。summary () Ë 
realEstate 数 据 框 为 ummary () RADA 41: 


> summary(realEstate) 


结果 如 下 : 


MedianHousevalue Medianincome 


现在 开始 


: 14999 
- 1119600 
:179700 
:206856 
- 1264725 


训练 模型 


Min. * D. 
lst Qu.: 
Median : 
Mean - 
3rd Qu.: 
Max. :15. 


2. 
3. 
3. 


4999 
5634 
5348 
8707 


4.7432 


0001 


Latitude 


:32. 
244. 
:34. 
245. 
:37. 
= ἃ ΚΝ 


Min. 
lst Qu. 
Median 
Mean 
3rd Qu. 
Max. 


880 129 322 126 37. 
7099 1106 2401 1138 37. 
1467 190 496 177 37. 
1274 235 558 219 37. 
1627 280 565 259 37. 

919 213 413 193 37. 


88 


-122. 
-122. 
-122. 
-122. 
-122. 
-122. 


23 


国 数 是 一 个 多 用 途 通 用 函数 ， 提 供与 单个 对 和 象 或 数据 框 相 天 的 数据 的 概要 。 
MedianHouseAge TotalRooms TotalBedrooms Population 
Min. : 1.00 Min. - 2 Min. : 1.0 Min. 3 
lst οι. «15.00 lst Qu.: 1448 lst Qu.: 295.0 lst Qu.: 787 
Median :29.00 Median : 2127 Median : 435.0 Median : 1166 
Mean :28. 64 Mean : 2636 Mean : 537.9 Mean : 1425 
3rd Qu. :37.00 3rd Qu.: 3148 3rd Qu.: 647.0 3rd Qu.: 1725 
Max. :52.00 Max. :39320 Max. :6445.0 Max. :35682 
Longitude 

Min. :-124.3 
lst Qu.:-121.8 
Median :-118.5 
Mean :-119.6 
3rd Qu. :-118.0 
Max. :-114.3 


准备 数据 集 的 模型 。 作 为 分 类 和 预测 的 工具 ， 


通过 从 树 的 根 忆 点 开始 直到 a 到达 叶 节 点 的 过 程 来 分 类 实例 。 


一 个 属性 。 


函数 tree () KALIT 
量 的 关系 将 响应 变量 化 


音 归 分 割 生成 树 的 方法 来 实现 
归 地 分 解 为 子 集 。 


决策 树 代表 人 类 可 以 理解 并 用 于 知识 系统 (如 数据 库 ) 中 的 规则 ， 并 


节点 指定 对 蛙 个 属性 的 测试 ,， 


分 类 树 。 这 些 模型 是 计算 


πιό ΕΕ 
£ 24-3 
L τς 


叶 节 点 则 表示 目标 属性 的 值 ， 


型 技术 ， 因 为 它们 根据 一 个 或 多 


边 则 分 离 


个 预测 变 


公式 表达 式 基 于 变量 Latitude 和 Longitude 之 和 ， 求 和 结果 存储 在 变量 Median HouseValue 的 对 数值 中 。data=realEstate 


表示 优先 解释 公 


\ 式 、 权 重 和 子 集 的 数据 框 。 


结果 存储 在 数据 框 treeModel 中 : 


> treeModel «- tree(log(MedianHouseValue) ~ Longitude + Latitude, 
data-realEstate) 


下 面 显示 treeModeI 的 概要 。 概 要 显示 所 使 用 的 公式 、 树 中 的 终端 节点 或 叶 节 点 的 数量 ， 以 及 残 差 的 统计 分 布 。 

国 数 sSummary () 用 于 显示 treeModel| 的 统计 概要 。 它 是 一 个 泛 型 ， 用 于 生成 各 种 拟 合 函数 的 概要 结果 。 将 需要 显示 概要 
的 数据 框 treeModel 作 为 输入 参数 传递 。 

在 这 里 ， 偏 差 是 指 均 方 误差 : 


> summary (treeModel) 


结果 如 下 : 


Regression tree: 

tree(formula = log(MedianHousevalue) ~ Longitude + Latitude, 
data — realEstate) 

Number of terminal nodes: 12 

Residual mean deviance: 0.1662 = 3429 / 20630 

Distribution of residuals: 
Min. ist Qu. Median Mean 3rd Qu. Max. 

-2.75900 -0.26080 -0.01359 0.00000 0.26310 1.84100 


使 用 函数 plot () 可 以 将 生成 的 数据 框 treeModel 显 示 为 图 像 ，treeModel 数 据 框 作为 函数 的 输入 参数 : 
> plot (treeMode1l) 


结果 如 下 : 











-- 











需要 为 显示 为 图 像 的 treeMode| 数 据 框 的 每 一 个 节点 和 叶 节 点 的 值 添加 文本 信息 。 使 用 函数 text () 在 给 定 坐 标 处 插入 标签 
向 量 中 给 出 的 字符 串 : 


> text(treeModel, cex=. 75) 


结果 如 下 : 


Longitude < -121.655 Latitude < 39 355 


Latitude « 37.925 Latitude « 34.675 


11.73 11.32 


12.48 12.10 
Longitude k -118.315 Longitude k -120.275 


Longitude < -11/.545 


Latitudg < 33.725 Latitude < 33.59 
Longitude < -116.33 


11.75 11.28 


12.53 


12.54 13.14 


第 4 步 : 对 比 预测 结果 


与 反映 全 球 价格 走势 的 数据 集 对 比 预 测 结果 。 为 了 更 方便 地 报告 或 比较 ， 我 们 希望 汇总 MedianHouseValue 的 频率 分 布 ， 
最 直接 的 方法 是 使 用 分 位 数 。 分 位 数 是 与 数值 排名 相关 的 分 布 中 的 一 个 点 。 分 位 数 将 划分 MedianHouseValue 分 布 ， 使 得 在 分 
位 数 之 下 存在 给 定 比 例 的 观测 结果 。 


函数 quantile () 产生 与 给 定 概率 相对 应 的 样本 分 位 数 。realEstate$MedianHouseValue 是 使 用 样本 分 位 数 的 数值 向 量 ， 
函数 quantile () 返回 priceDeciles 作 为 向 量 的 长 度 : 


> priceDeciles «- quantile(realEstate$MedianHouseValue, 0:10/10) 
查看 数据 框 priceDeciles 的 值 : 

> priceDeciles 

结果 如 下 : 


0x 10% 20% 30% 40% 50% 60% 70% 80% 90% 100% 
14999 82300 107200 134000 157300 179700 209400 241930 290000 376600 500001 


接 下 来 ， 使 用 Summary () PEZipktiznpriceDecilesB frg, priceDecilesf/E7JERZNBSs8 A Z2 : 


> summary (priceDeciles) 


结果 如 下 : 


Min. 1st Qu. Median Mean 3rd Qu. Max. 
15000 120600 179700 208500 266000 500000 


下 面 使 用 函数 cut () TRiEPTEBSJIRINSXUTIBENS SE, fprceDecilesxllZr7JW93 ExiR), ZX3stErealEstateB Zi Bim] & 
MedianHouseValue 将 通过 切换 转换 为 一 个 因子 : 


> cutPrices <- cut(realEstate$MedianHouseValue, priceDeciles, 
include.lowest-TRUE) 


输出 cutPrices 数 据 框 。 使 用 遂 数 head () 返回 CutPrices 数 据 框 的 头 部 数据 ，cutPrices 作 为 负数 的 输入 参数 : 


> head(cutPrices) 


结果 如 下 : 


[1] (3.77e+05,5e+05] (2.9e-05,3.77e*-05] (2.9e-05,3.77e«-05] (2.9e-05,3.77e«*05] (2.9e-05,3.77e4«05] 
[6] (2.42e405,2.9e405] 
10 Levels: [1.56:04,8. 23604] (8.23e404,1.07e*05] (1.07e*-05,1.34e«05] ... (3.77ἑε105, 56105] 


Fi&fsFBeRZAsummary () 来 显示 数据 框 cutPrices 的 概要 ，cutPrices 作 为 国 数 的 输入 参数 : 


> summary (cutPrices) 


结果 如 下 : 
[1. 56048. 236904] (8.23e«-04,1.07e«-05] (1.07e«-05,1.34e«-05] (1.34e«05,1. 57e«05] 
2065 
(1.57e-05,1.8e-05] (1.8e4-05,2.09e-05] (2.09e-05,2.42e«-05] (2.426805,2. 96:05] 
2065 2067 2058 2067 
(2.9e405,3.77e405] — (3.77e405,5e«05] 
2062 2063 


使 用 函数 plot () #lcutPricesh A, ZWiefEcutPriceslEZJERZXB JAN S 2X. realEstateziimSkRJLongitudese&zzn gr 
x 轴 坐 标 ，Latitude 变 量 表 示 图 中 y 轴 坐标 。col=gray (10: 2/11) 表示 绘图 颜色 。pch =20 表 示 在 绘制 符号 的 默认 大 小 。 
xlab="Longitude "表示 x 轴 的 标题 ， 而 ylab= "Latitude "表示 y 轴 的 标题 : 


> plot(realEstate$Longitude, realEstate$Latitude, 
col2grey(10:2/11)[cutPrices], pch-20, xlab-"Longitude",ylab-"Latitude") 


结果 如 下 : 


42 


40 


38 


36 


34 





-124 -122 -120 -118 -116 -114 


使 用 函数 summary () 显示 Longitude 的 统计 概要 : 


> summary (realEstate$Longitude) 


结果 如 下 : 


Min. 1st Qu. Median Mean 3rd Qu. Max. 
-124.4 -121.8 -118.5 -119.6 -118.0 -114.3 


使 用 函数 head () 输出 Longitude 数 据 框 的 头 部 数据 : 

> head (realEstate$Longitude) 

结果 如 下 : 

[1] -122.23 -122.22 -122.24 -122.25 -122.25 -122.25 
使 用 函数 summary () 显示 Latitude 的 统计 概要 : 

> summary (realEstate$Latitude) 

结果 如 下 : 


Min. 1st Qu. Median Mean 3rd Qu. Max. 
32.54 33.93 34.26 35. 63 37.71 41.95 


使 用 函数 head () 输出 Latitude 数 据 框 的 头 部 数据 : 


> head(realEstateS$Latitude) 


结果 如 下 : 


[1] 37.88 37.86 37.85 37.85 37.85 37.85 


E&ZXpartition.tree () 用 于 划分 涉及 两 个 或 多 个 变量 的 树 ， 树 对 象 tree Model 作 为 函数 的 输入 参数 。 
ordvars-c ("Longitude", "Latitude") 表示 变量 用 于 绘图 的 顺序 。Longitude 表 示 x 轴 ， 而 Latitude 表 示 y 轴 。add=TRUE 表 示 
添加 到 已 有 图 中 : 


> partition.tree(treeModel, ordvars-c("Longitude","Latitude"), 
add- TRUE) 


结果 如 下 : 














11.3 














-122 -120 -118 -116 -114 


第 5 步 : 改进 模型 


树 中 的 叶 世 点数 量 控 制 了 树 的 灵活 性 。 叶 节操 数量 表示 把 树 分 割 成 多 少 个 单元 。 每 个 书 点 必须 包含 一 定数 量 的 感 ， 并 且 添 加 
节操 必 须 减 少 一 定量 的 错误 。min.dev 的 默认 值 为 0.01。 


下 面 将 min.dev 的 值 降低 至 0.001。 


使 用 函数 tree () 来 实现 分 类 树 。 公 式 表 达 式 基于 变量 Latitude 和 Longitude 之 和 ， 求 和 结果 存储 在 变量 
MedianHouseValue 的 对 数值 中 。data=realEstate 表 示 优 先 解 释 公 式 、 权 重 和 子 集 的 数据 框 。min.dev 的 值 表 示 必 须 是 要 分 割 
节点 的 根 节点 至 少 0.001 倍 的 偏差 。 


结果 存储 在 treeM odel2 数 据 框 中 : 


> treeModel2 «- tree(log(MedianHouseValue) ~ Longitude + Latitude, 
data-realEstate, mindev-0.001) 


下 面 显 示 treeModel2 的 概要 。 概 要 显示 所 使 用 的 公式 、 树 中 的 终端 节点 或 叶 节点 的 数量 ， 以 及 残 差 的 统计 分 布 。 
函数 summary () 用 于 显示 treeModel2 的 统计 概要 。 将 需要 显示 概要 的 数据 框 treeModel2 作 为 输入 参数 传递 。 


TXE, MEERA: 


> summary (treeModel2) 


结果 如 下 : 


Regression tree: 

tree(formula = log(MedianHousevalue) — Longitude + Latitude, 
data = realEstate, mindev = 0.001) 

Number of terminal nodes: 68 

Residual mean deviance: 0.1052 = 2164 / 20570 

Distribution of residuals: 
Min. 1st Qu. Median Mean 3rd Qu. Max. 

-2.94700 -0.19790 -0.01872 0.00000 0.19970 1.60600 


与 treeModelI 的 概要 相 比 ，treeModel2 中 的 叶 节 点 值 从 12 增 加 到 68。 人 偏差 值 从 treeModel 模 型 的 0.1666 变 为 treeModel2 


的 0.1052。 


使 用 通用 的 绘制 函数 plot () 可 以 将 生成 的 数据 框 treeModel2 显 示 为 图 像 ，treeModel2 作 为 函数 的 输入 参数 : 


> plot(treeModel2) 


结果 如 下 : 


需要 为 显示 为 图 像 的 数据 框 treeModel2 的 每 一 个 
签 向 量 中 给 出 的 字符 串 : 


> text(treeModel2, cex-.65) 


结果 如 下 : 


PRAP ARRERA ER. 


Longitude < -121.655 


Latitude < 37.925 


Longitude < -122.305 ongit - 
ὡς Latitude < 37.585 Latio dude 1:5. 3355 
ongitude < -122. "e DAAA 8 





Latitude < 34.165 
Longitude < -ῄ, 
ια μάς 3$ 855 
12.68 12.82 21.55 18.91 
12.39 32 ac mp ep 42.32 92 2m ea αν 89.73 Longitude ` 
11.8p. am 42.21 


12.86 
1265 412 
12.54 


Latitude < 34.675 


Longitude [< -118.315 


Longitude « -117.545 


使 用 函数 text () 在 给 定 坐标 处 插入 标 


Latitude < 39 355 


Long italia Ad EE ed's 


Longitude  -120.275 


Longitédd Berlin ERA 9 和 .935 
1242 4.78 449055 


Latitude « 33.725 Latitude « 33.59 
Latitude « 34. 105 Longit x I 
ongitude < - ως ων ohenglie VT Sar w. 1342055 
Ξ ^ " ees uda; 
Β qe cs EVE "pm umm Aa. 
' Sinn Lo 32.755 
12.14 gg 44 881.1 73 20 288.64 
114.77.21.52 


12 ar κ 4.88 


其 中 包含 公式 扩展 中 的 所 有 变量 。 
ER tree () 实现 了 分 类 树 。 公 式 表 达 式 基于 所 有 变量 。 
结果 存储 在 treeModel3 数 据 框 中 : 


> treeModel3 «- tree(log(MedianHouseValue) ~ ., data=realEstate) 


下 面 显示 treeModel3 的 概要 。 概 要 显示 所 使 用 的 公式 、 树 中 的 终端 节操 或 叶 节 点 的 数量 ， 以 及 残 笑 的 统计 分 布 。 
函数 summary () 用 于 显示 treeModel3 的 统计 概要 。 将 需要 显示 概要 的 数据 框 treeModel3 作 为 输入 参数 传递 。 
TXE, MEERI RA: 


> summary (treeModel3) 


+ š 
结果 如 下 : 

Regression tree: 

tree(formula = log(MedianHousevalue) — ., data = realEstate) 

Variables actually used in tree construction: 

[1] "Medianrncome" "Latitude" "Longitude" "Medi anHouseAge" 


Number of terminal nodes: 15 
Residual mean deviance: 0.1321 = 2724 / 20620 
Distribution of residuals: 

Min. 1st Qu. Median Mean 3rd Qu. Max. 
-2.86000 -0.22650 -0.01475 0.00000 0.20740 2.03900 


公式 表达 式 清 楚 显 示 了 realEstate 数 据 集 的 所 有 变量 。 


使 用 通用 的 绘制 函数 plot () 可 以 将 生成 的 数据 框 treeModel3 显 示 为 图 像 ，treeModel3 作 为 函数 的 输入 参数 : 


> plot(treeModel3) 


结果 如 下 : 


需要 为 显示 为 图 像 的 数据 框 treeModel3 的 每 一 个 节点 和 叶 节点 的 值 添加 文本 信息 。 使 用 函数 text () 在 给 定 坐标 处 插入 标 


HERAF: 


> text(treeModel3, cex=.75) 


士 ° 
MedianInconhe < 2.51025 Medianincome « 5.5892 
Latitude « 34.465 Latitude « 37.925 
Longitude « -122.235 
Longitude « -117.775 Longitude « -120.275 Latitude « 34.455 MedianHouseAge « 38.5 Medianincome < 7.393 
Latitude « 37.905 Longitude « -117.765 Longitude « -120.385 


12.48 


6.4 决策 树 学 习 : 预测 股票 走势 方向 


股票 交易 是 统计 人 员 试 图 解决 的 最 具 挑 战 性 的 问题 之 一 。 有 诸多 的 技术 指标 ， 例 如 走势 万 向 ， 市 场 活力 是 人 否 缺 乏 ， 鳃 利 潜 
波动 ， 以 及 市 场 中 监测 流行 度 的 成 交 量 措施 等 。 这 些 指标 可 为 高 可 靠 性 交易 机 会 创造 策略 。 友 现 技术 指标 之 间 的 关系 可 能 需要 人 论 
费 几 天 / 周 /月 的 时 间 ， 因 此 需要 使 用 诸如 决策 树 之 类 的 高 效 省 时 的 工具 。 决 策 树 的 主要 优点 是 ， 它 是 一 个 强大 且 易 于 解释 的 算 
法 。 


准备 工作 
我 们 使 用 股票 市 场 的 数据 集 来 搭建 决策 树 分 类 。 


第 1 步 : 收集 和 摘 述 数据 


数据 集 选 取 美 国 银行 在 2012 年 1 月 1 日 至 2014 年 1 月 1 日 之 间 每 日 收盘 价 的 值 。 将 要 下 载 的 数据 集 可 以 在 以 下 网 址 免费 获 
得 : http://yahoo.com, 


具体 实施 步骤 
以 下 为 实现 细节 。 


第 2 步 : 探索 数据 


首先 需要 加 载 以 下 软件 包 : 


> install.packages ("quantmod") 
» install.packages("rpart") 
» install.packages("rpart.plot") 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.3.0 (2016-05-03) ο 


需要 安 半 以 上 软件 包 的 相应 库 ; 


> library("quantmod") 
> library("rpart") 
> library("rpart.plot") 


现在 开始 标记 所 需 数 据 时 间 段 的 起 始 时 间 和 结束 时 间 ， 并 下 载 数 据 。 
国 数 as.Date () 用 于 将 字符 表示 的 日 期 转换 为 Date 类 的 对 象 。 
数据 集 的 初始 日 期 存 于 startDate 中 ， 表 示 格 式 为 YYYY-MM-DD: 


> startDate = as.Date("2012-01-01") 


数据 集 的 结束 日 期 存 于 endDate 中 ， 表 示 格 式 为 YYYY-MM-DD: 


> endDate = as.Date("2014-01-01") 


使 用 函数 getsymbols () 加 载 数据 。 该 消 数 从 本 地 或 远程 的 多 个 源 加 载 数据 。 提 取 数 据 并 保存 在 指定 的 env 中 。env 的 默认 
值 为 .GlobalEnv。BAC 是 指定 要 加 载 符号 名 称 的 字符 向 量 。src=yahoo 指 定 选择 源 的 方法 : 


> getSymbols("BAC", env = .GlobalEnv, src = "yahoo", from = startDate, 
to = endDate) 


第 3 步 : 计算 指标 

计算 相对 强度 指数 (Relative Strength Index) 。 相 对 强度 指数 是 近期 上 涨 价格 走势 与 绝对 价格 走势 的 比率 ， 这 里 使 用 沙 
ARSI () 来 计算 相对 强度 指数 ， 符 号 BAC 表 示 价 格 系列 ，n=3 表 示 移 动 平均 线 的 周期 数 。 结 果 和 存储 在 数据 框 
relativeStrengthindex3 中 : 

> relativeStrengthIndex3 <- RSI (Op (BAC), n= 3) 


显示 relativestrengthlndex3 的 值 : 


> relativeStrengthIndex3 


结果 如 下 : 


2012-01-03 
2012-01-04 
2012-01-05 
2012-01-06 
2012-01-09 
2012-01-10 
2012-01-11 
2012-01-12 
2012-01-13 
2012-01-17 
2012-01-18 
2012-01-19 
2012-01-20 
2012-01-23 
2012-01-24 
2012-01-25 
2012-01-26 
2012-01-27 
2012-01-30 
2012-01-31 
2012-02-01 
2012-02-02 
2012-02-03 
2012-02-06 
2012-02-07 
2012-02-08 
2012-02-09 
2012-02-10 
2012-02-13 
2012-02-14 
2012-02-15 
2012-02-16 
2012-02-17 
2012-02-21 


EMA 


92.592593 
93.495935 
96. 0/8431 
97 .433897 
98. 808238 
47 . 60604109 
57 . 014319 
45.653652 
/9.354816 
59.192256 
67.711649 
65.434854 
71.828809 
84.090916 
51.691301 
43. 341684 
49.463943 
61.835597 
/9.102066 
88. 80/546 
91.969539 
94.722215 
94.886539 
98.059105 
57.977139 
72.331575 
56. 532020 
40. 898355 
21.651993 
55. 896895 
54. 807992 





计算 移动 平均 线 。 作 为 一 种 技术 指标 ， 指 数 移 动 平均 线 (exponential moving average) 用 于 实现 技术 分 析 。 在 简单 移动 
平均 线 (simple moving average) 中 ， 系 列 中 的 每 个 值 都 具有 相同 的 权重 。 时 间 序 列 之 外 的 值 不 包括 在 平均 线 中 。 然 而 ， 指 数 
移动 平均 线 的 值 是 罕 积 计算 ,包括 所 有 数据 。 过 去 数据 的 价值 是 递减 的 ， 而 数据 时 间 越 近 ， 价 值 越 高 。 


ERZXEMA () 使 用 符号 BAC 代 表 价 格 系列 ，n= 5 代表 平 均线 的 时 间 段 ， 结 果 存 储 在 数据 框 exponentialMovingAverage5 
rR: 


> exponentialMovingAverage5 <- EMA (Op (BAC) ,n=5) 


显示 exponentialMovingAverage5 的 值 : 


> exponentialMovingAverage5 


结果 如 下 : 


2012-01-13 


-0. 0130370370 


2012-01-17  0.0846419753 
2012-01-18 -0.0302386831 
2012-01-19 0.4531742112 
2012-01-20 0.1287828075 
2012-01-23 Ο. 2058552050 
2012-01-24  0.1239034700 
2012-01-25 30.1426023133 
2012-01-26  0.261/3487/756 
2012-01-27 0.0144899170 
2012-01-30 -0.0436/33886 
2012-01-31 -0.0024489258 
2012-02-01  0.0517007/7162 
2012-02-02  0.15446/1441 
2012-02-03 4 0.2563114294 
2012-02-06  0.25/5409529 
2012-02-07 Ο. 2783606353 
2012-02-08 4 0.1922404215 
2012-02-09  0.3614936157 
2012-02-10  0.06/6624105 
2012-02-13  0.19177/49403 
2012-02-14  0.0478499602 
2012-02-15 -0.0614333599 
2012-02-16 -0. 2409555732 
2012-02-17 0.0593629512 
2012-02-21  0.0329086341 
2012-02-22 0.041939089%4 
2012-02-23 -0.0320406071 
2012-02-24 0.0319729286 
2012-02-27 -0.1520180476 
2012-02-28 0.0719879683 


探索 exponentialMovingAverage5 数 据 框 的 维度 。 使 用 dim () 尔 数 返回 exponentialMovingAverage5 数 据 框 的 维 
度 ，exponentialMovingAverage5 作 为 水 数 的 输入 参数 。 返 回 结果 清楚 地 显示 数据 框 有 502 行 和 1 列 : 


> dim(exponentialMovingAverage5) 


结果 如 下 : 


[1] 502 1 


探索 exponentialMovingAverage5 数 据 框 的 内 部 结构 。 使 用 函数 str () 探索 作为 R 对 象 的 exponentialMovingAverage5 
数据 框 的 内 部 结构 : 


> str(exponentialMovingAverage5) 


结果 如 下 : 


An 'xts' object on 2012-01-03/2013-12-31 containing: 
Data: num [1:502, 1] NA NA NA NA 5.94 ... 
- attr(*, "dimnames")-List of 2 
..$ : NULL 
..$ : chr TEMA” 
Indexed by objects of class: [Date] TZ: υτς 
xts Attributes: 
List of 2 
$ src : chr "yahoo" 
$ updated: POSIXct[1:1], format: "2016-07-22 15:13:25" 


计算 价格 与 exponentialMovingAverage5 之 间 的 差异 ， 例 如 5 年 的 指数 移动 平均 值 ， 结 果 人 存储 在 
exponentialMovingAverageDiff 数 据 框 中 : 


> exponentialMovingAverageDiff <- Op(BAC)-exponentialMovingAverageb 


比较 BAC 系 列 的 快速 移动 平均 线 与 BAC 系 列 的 绥 慢 移动 平均 线 。BAC 以 价格 矩阵 的 方式 作为 输入 参数 。fast=12 表 示 快 速 移 
动 平均 线 的 周期 ，slow=26 表 示 绥 慢 移 动 平均 线 的 周期 ，signal=9 表 示 移 动 平均 线 的 信号 : 


> MACD «- MACD (OP (BAC) , fast = 12, slow = 26, signal = 9) 


显示 MACD 的 值 : 


> MACD 


结果 如 下 : 


a 
--. 
f=] 
=- | 
EJ 
— 


2012-01-03 
2012-01-04 
2012-01-05 
2012-01-06 
2012-01-09 
2012-01-10 
2012-01-11 
2012-01-12 
2012-01-13 
2012-01-17 
2012-01-18 
2012-01-19 
2012-01-20 
2012-01-23 
2012-01-24 
2012-01-25 
2012-01-26 
2012-01-27 
2012-01-30 
2012-01-31 
2012-02-01 
2012-02-02 
2012-02-03 
2012-02-06 
2012-02-07 
2012-02-08 7.805070032 
2012-02-09  8.085846209 


= 
EREEEEEEEEEEEEEEEEEEEEEEER 


E £ S £ S S S S 5 S 5 5 S 5 £ S S £ S £ S S 5 É 5 


2012-02-10 
2012-02-13 
2012-02-14 
2012-02-15 
2012-02-16 
2012-02-17 


. 022208050 
. 922024506 
. 696811589 
. 283884784 
. 369682439 
.2/248/938 


£ £ S Š £ Š 


2012-02-21 
2012-02-22 


.955405657 Z.279269023 
.667469977 6.956909214 


Ln ω ο ο s s N N 


输出 MACD 数 据 框 : 使 用 函数 head () jiZ[HIMACDšJSMEBJSLBBZMIE, MACDAIUmTETFZJERZRBSASAN SS SA: 


> head (MACD ) 


结果 如 下 : 


macd signal 


2012-01-03 ΝΑ, ΝΑ 
2012-01-04 NA NA 
2012-01-05 NA NA 
2012-01-06 NA NA 
2012-01-09 NA NA 
2012-01-10 NA NA 


选取 信号 线 作 为 指标 。 结 果 存 储 在 数据 框 MACDsignal 中 : 


> MACDsignal «- MACD[,2] 


显示 MACDsignal 的 值 : 


> MACDsignal 


结果 如 下 : 


2012-01-17 
2012-01-18 
2012-01-19 
2012-01-20 
2012-01-23 
2012-01-24 
2012-01-25 
2012-01-26 
2012-01-27 
2012-01-30 
2012-01-31 
2012-02-01 
2012-02-02 
2012-02-03 
2012-02-06 
2012-02-07 
2012-02-08 
2012-02-09 
2012-02-10 
2012-02-13 
2012-02-14 
2012-02-15 
2012-02-16 
2012-02-17 


安安 安安 有 有 有 有 有 


2012-02-21 7.279269023 
2012-02-22 6.956909214 
2012-02-23 6.622470704 
2012-02-24 6.298893029 
2012-02-27 5.932154164 
2012-02-28  5.596629643 
2012-02-29 5.30/348654 


Tdi Es RN CEAR IR] RE LER. {ΕΗΜΕΗΗΚΡΕΜΙΗΛΕΕΕΧΊΗΧΗ J ren RNC ERIA. BIEN 
SMI () 用 于 动量 指示 器 。 


BAC 是 包含 最 高 -最 低 - 收 盘 的 价格 矩阵 ，n= 13 表 示 周 期 数 ，slow=25 表 示 双 重 平滑 的 周期 数 ，fast= 2 表示 初始 平滑 的 周期 
数 ，signal=9 表 示 信 号 线 的 周期 数 ， 结 果 和 存储 在 数据 框 stochasticOscillator 中 : 


> stochasticOscillator <- SMI (OP (BAC) ,n=13,slow=25, fast=2, signal=9) 


显示 StochasticOscillator 的 值 : 


> stochasticOscillator 


结果 如 下 : 


2012-01-12 
2012-01-13 
2012-01-17 
2012-01-18 
2012-01-19 
2012-01-20 
2012-01-23 
2012-01-24 
2012-01-25 
2012-01-26 
2012-01-27 
2012-01-30 
2012-01-31 
2012-02-01 
2012-02-02 
2012-02-03 
2012-02-06 
2012-02-07 
2012-02-08 
2012-02-09 
2012-02-10 
2012-02-13 
2012-02-14 
2012-02-15 
2012-02-16 
2012-02-17 
2012-02-21 
2012-02-22 
2012-02-23 
2012-02-24 
2012-02-27 


选取 振荡 器 作为 指标 。 结 果 人 存储 在 数据 框 stochasticOscillatorsignal 中 : 


> stochasticOscillatorSignal <- stochasticOscillator[,1] 


£ £ ç £ £ £ 5 Š 5 5 5 6 5 5 5 5 Š 5 


80. 3129074 
82.8992932 
81.1582428 
81.7157047 
81.1498062 
78.4958391 
71.6591168 
68.1994284 
65.4572862 
62. 91340301 
59.2364325 
56. 2995258 
30. 2837296 


£ 5 S S 5 S G b S 5 5 S 5 5 S 5 S S 5 S 5 5 5 5 Š 


£ 


76. 78306943 
74.00924356 
71.05468134 
68.10365022 
64. 53966610 


显示 StochasticOscillatorSignal 的 值 : 


> stochasticOscillatorSignal 


结果 如 下 : 


2012-02-03 
2012-02-06 
2012-02-07 
2012-02-08 
2012-02-09 
2012-02-10 
2012-02-13 
2012-02-14 
2012-02-15 
2012-02-16 
2012-02-17 
2012-02-21 
2012-02-22 
2012-02-23 
2012-02-24 
2012-02-27 
2012-02-28 
2012-02-29 
2012-03-01 
2012-03-02 
2012-03-05 
2012-03-06 
2012-03-07 
2012-03-08 
2012-03-09 
2012-03-12 
2012-03-13 
2012-03-14 
2012-03-15 
2012-03-16 
2012-03-19 


ΝΑ 

NA 

ΝΑ 
80. 3129074 
82. 8992932 
81.1582428 
81.7157047 
81.1498062 
/8.4958391 
/1.6591168 
68.1994284 
65.4572862 
62.9139401 
59. 2364325 
56. 2095258 
50. 2837296 
46. 8890757 
46. 3290434 
45.7386847 
46. 5724049 
47. 5768473 
43. 9686727 
39.0152520 
37 . 8043691 
38. 6988311 
38.4206230 
38. 8030183 
43. 5628586 
50.4453915 
58. 2642458 
65. 7203944 


£ £ £ £ $ 5 5 5 5 5 5 


76. 78306943 
74.00924356 
71.05468134 
68.10365022 
64.53966610 
61.00954803 
58.07344711 
55. 60649462 
53. 79967668 
52.55511079 
50.83782317 
48.47330894 
46. 33952098 
44.81138300 
43. 53323099 
42.58/18845 
42./8232248 
44. 31493628 
47 . 10479819 
50. 82791743 


第 4 步 : 准备 变量 构建 数据 集 


计算 开盘 价 和 收盘 价 的 差别 。 CI 代表 收盘 价 ，Op 代 表 开盘 价 ， 结 果 存 储 在 数据 框 PriceChange 中 | 


> PriceChange <- Cl (ΒΑΟ) 


显示 PriceChange 的 值 : 


> PriceChange 


结果 如 下 : 


2012-01-26 
2012-01-27 
2012-01-30 
2012-01-31 
2012-02-01 
2012-02-02 
2012-02-03 
2012-02-06 
2012-02-07 
2012-02-08 
2012-02-09 
2012-02-10 
2012-02-13 
2012-02-14 


£ £ S Š Š S S Š Š 


80. 3129074 
82. 8992932 
81.1582428 
81.7157047 
81.1498062 


- Op (BAC) 


2012-02-15 
2012-02-16 
2012-02-17 
2012-02-21 
2012-02-22 
2012-02-23 
2012-02-24 
2012-02-27 
2012-02-28 
2012-02-29 
2012-03-01 
2012-03-02 
2012-03-05 
2012-03-06 
2012-03-07 
2012-03-08 
2012-03-09 


78.4958391 
71.6591168 
68.1994284 
65.4572862 
62.9139401 
59.2364325 
56.2995258 
50.2837296 
46.8890757 
46. 3290434 
45.7386847 
46.5724049 
47.5708473 
43.9686727 
39.0152520 
37. 8043691 
38. 6988311 


POEZD. BRENifelse () 返回 值 为 测试 表达 式 ， 它 本 身 是 一 个 向 量 ， 并 且 与 测试 表达 式 的 长 度 相同 。 如 果 测 试 表 
达 式 的 相应 值 为 TRUE， 则 返回 的 向 量具 有 来 自 x 的 元 素 ; 如 果 测 试 表达 式 的 相应 值 为 FALSE， 则 返回 的 元 素 具 有 来 自 y 的 元 素 。 


这 里 ，PriceChange>0 是 测试 浮 数 ， 它 将 以 逻辑 模式 进行 测试 。 使 用 参数 UP 和 DOWN 执 行 逻辑 测试 ， 然 后 将 结果 存储 在 
数据 框 binaryClassification 中 : 


> binaryClassification <- ifelse(PriceChange>0,"UP","DOWN") 


显示 binaryClassification 的 值 : 


> binaryClassification 


结果 如 下 : 


BAC.Close 
2012-01-03 "UP™ 
2012-01-04 “uP” 
2012-01-05 "uP" 
2012-01-06 "DOWN" 
2012-01-09 "up" 
2012-01-10 "uP" 
2012-01-11 “UP™ 
2012-01-12 "DOWN" 
2012-01-13 "uP" 
2012-01-17 "DOWN" 
2012-01-18 "uP" 
2012-01-19 "DOWN" 
2012-01-20 "uP" 
2012-01-23 "uP" 
2012-01-24 "UP" 
2012-01-25 "uP" 
2012-01-26 "DOWN" 
2012-01-27 "UP" 
2012-01-30 "DOWN" 
2012-01-31 "DOWN" 
2012-02-01 "up" 
2012-02-02 "UP" 
2012-02-03 "UP" 
2012-02-06 "uP" 
2012-02-07 "DOWN" 
2012-02-08 "uP" 
2012-02-09 "DOWN" 
2012-02-10 "uP" 
2012-02-13 "DOWN" 


探索 binaryClassification 数 据 框 的 内 部 结构 。 使 用 函数 str () 探索 作为 R 对 象 的 binaryClassification 数 据 框 的 内 部 结构 : 


> str(binaryClassification) 


结果 如 下 : 


An 'xts' object on 2012-01-03/2013-12-31 containing: 


Data: chr [1:502, 1] "uP" "uP" "uP" "DOWN" "UP" "UP" "UP" "DOWN" "UP" "DOWN" "UP" ... 


- attr(*, "dimnames")-List of 2 
. NULL 
: chr "BAC.Close" 


--4 
ο 


Indexed by objects of class: [Date] Tz: 
xts Attributes: 


NULL 


创建 待 用 数据 集 。 基 于 索 密 耦合 的 变量 集 ， 
递 给 data.frame () 的 变量 有 relativestrengthlndex3、exponentialMovingAverageDiff、MACDsignal、 


stochasticOscillator 和 binaryClassification。 


结果 存储 在 数据 框 DataSet 中 : 


使 用 函数 data.frame () 创建 数据 框 。 这 


> DataSet «- data.frame(relativeStrengthIndex3, 


exponentialMovingAverageDiff, MACDsignal, 


binaryClassification) 


显示 DataSet 的 值 : 
> DataSet 
结果 如 下 : 

EMA BAC.Open signal SMI BAC.Close 
2012-01-03 NA NA NA NA UP 
2012-01-04 NA NA NA NA UP 
2012-01-05 NA NA NA NA UP 
2012-01-06 92.592593 NA NA NA DOWN 
2012-01-09 93.495935 40.3240000000 NA NA UP 
2012-01-10 96.078431  0.3360000000 NA NA UP 
2012-01-11 97.435897 0.3306666667 NA NA UP 
2012-01-12 98.868258 0O0.4804444444 NA NA DOWN 
2012-01-13 47.664109 -0.013037/70370 NA NA UP 
2012-01-17 57.014319 30.0846419753 NA NA DOWN 
2012-01-18 45.653652 -0.0302386831 NA NA UP 
2012-01-19 79.354816 30.4531742112 NA NA DOWN 
2012-01-20 59.192256 0.1287/7828075 NA NA UP 
2012-01-23 67.711649 ο. 2058552050 NA NA UP 
2012-01-24 65.434854 30.1239034700 NA NA UP 
2012-01-25 71.828809 0.1426023133 NA NA UP 
2012-01-26 84.090916 40.201/348/56 NA NA DOWN 
2012-01-27 51.691301 30.0144899170 NA NA UP 
2012-01-30 43.341684 -0. 0436733886 NA NA DOWN 
2012-01-31 49.463943 -0.0024489258 NA NA DOWN 
2012-02-01 61.835597 0.0517/7007162 NA NA UP 
2012-02-02 79.102066 20.1544671441 NA NA UP 
2012-02-03 88.807546 Ο. 2301114204 NA NA UP 
2012-02-06 91.969539 0.257/5409529 NA NA UP 
2012-02-07 94.722215 0O0.27/783606353 NA NA DOWN 
2012-02-08 94.886539 0.1922404235 NA 80.3129074 UP 


些 变 量 共 


stochasticOscillator, 


享 算 阵 的 属性 。 作 为 参数 传 


2012-02-09 98.059105 40.3614936157 
2012-02-10 57.977139 0.0676624105 
2012-02-13 72.331575 0O0.191//49403 


NA 82.8992932 DOWN 
NA 81.1582428 UP 
NA 81.7157047 DOWN 


输出 DatasSet 数 据 框 。 使 用 函数 head () 返回 Dataset 数 据 框 的 头 部 数据 ，Dataset 作 为 国 数 的 输入 参数 : 


> head (DataSet) 


结果 如 下 : 

EMA BAC.Open signal SMI BAC.Close 
2012-01-03 NA NA NA ΝΑ UP 
2012-01-04 NA NA NA NA UP 
2012-01-05 NA NA NA NA UP 
2012-01-06 92.59259 NA NA ΝΑ DOWN 
2012-01-09 93.49593 0.324 NA ΝΑ UP 
2012-01-10 96.07843 0.336 NA ΝΑ UP 


Pazz DataSetš (ER AŠA. fERdEREXSstr () 探索 作为 R 对 象 的 Dataset 数 据 框 的 内 部 结构 : 


> str(DataSet) 


结果 如 下 : 

"data.frame” : 502 obs. of 5 variables: 

$ EMA : num NA ΝΑ ΝΑ 92.6 93.5 ... 

$ BAC.Open : num ΝΑ ΝΑ ΝΑ ΝΑ 0.324 ... 

$ signal : num ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ... 

$ SMI : num ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ... 

$ BAC.Close: Factor w/ 2 levels "DOWN","UP": 2 2 2 1 2 2 2 1 2 1 ... 


IEMA. Kc () 用 于 将 参数 组 合成 向 量 。 


函数 c () 的 输入 人 参数 为 relativeStrengthlndex3、exponentialMovingAverageDiff、MACDsignal、 


stochasticOscillator 和 binaryClassification : 


> colnames (DataSet) <- c("relativeStrengthIndex3", 
"exponentialMovingAverageDiff", "MACDsignal", "stochasticOscillator", 
"binaryClassification") 


显示 colnames (DataSet) 的 值 : 


> colnames (DataSet) 


结果 如 下 : 
[1] "relativestrengthindex3i" "exponentialMovingAverageDiff" "MACDsignal" 
[4] "stochasticoscillator" "binaryclassification" 


去 挥 计算 指标 的 数据 : 


> DataSet <- DataSet[-c(1:33),] 


显示 DatasSet 的 值 : 


> DataSet 


结果 如 下 : 

















 relativeStrengthindex3 * | exponentialMovingAverageDiff * | MACDsignal * | stochasticOscillator * 
2012-02-21 54.807992 0.0329086341 |  7.279269023 65.4572862 | UP 
2012-02-22 58.450340 0.0419390894 | 6.956909214 62.9139401 | DOWN 
2012-02-23 42.893436 -0.0320406071 | 6.622470704 59.2364325 | UP 
2012-02-24 | 57.851032 0.0319729286 | — 6.298893029 | 56.2995258 | DOWN 
2012-02-27 25.408018 -0.1520180476 | — 5.932154164 50.2837296 | UP 
2012-02-28 59.487389 0.0719879683 | 5.596629643 46.8890757 | UP 
2012-02-29 68.593445 01213253122 |  5.307348654 46.3290434 | DOWN 
2012-03-01 56.476240 0.0342168748 | — 5.035722759 45.7386847 | UP 
2012-03-02 59.539437 0.0361445832 |  4.781732933 46.5724049 | UP 
2012-03-05 | 53.854072 0.0107630555 |  4.537052201 47.5768473 | DOWN 
2012-03-06 16.724239 -0.1994912964 | 4.238735482 43.9686727 | DOWN 
2012-03-07 24.300395 -0.1129941976 | 3.918826916 39.0152520 | UP 
2012-03-08 65.318323 0.0980038683 | 3.645464627᾽ 37.8043691 | DOWN 
2012-03-09 70.006417 0.0986692455 | 3.417166445 38.6988311 | DOWN 
2012-03-12 48.411252 -0.0075538363 | 3.199182324 38.4206230 | DOWN 
2012-03-13 | 58.807692 0.0349641091 | 3.003753810 38.8030183 | UP 
2012-03-14. 89.630630 0.4166427394 | — 2.942658473 | 43.5628586 | UP 
2012-03-15 93.554439 0.4910951596 | 3.022805761 50.4453915 | UP 
2012-03-16 96.343401 0.6140634397 | — 3.259451282 58.2642458 | UP 
2012-03-19 97.653738 0.6560422932 | 3.638235347 65.7203944 | DOWN 
2012-03-20 80.181102 0.3373615288 |  4.044359154 69.8327010 | UP 











输出 DatasSet 数 据 框 。 使 用 函数 head () 返回 Dataset 数 据 框 的 头 部 数据 ，Dataset 作 为 函数 的 输入 参数 : 


> head(DataSet) 


结果 如 下 : 
relativestrengthindex3 exponentialMovingAverageDiff MACDsignal stochasticoscillator 
2012-02-21 54.80799 0.03290863 7.279269 65.45729 
2012-02-22 58.45034 0.04193909 6.956909 62.91394 
2012-02-23 42.89344 -0.03204061 6.622471 59.23643 
2012-02-24 57.85103 0.03197293 6.298893 56.29953 
2012-02-27 25.40802 -0.15201805 5.932154 50.28373 
2012-02-28 59.48739 0.07198797 5.596630 46. 88908 
binaryclassification 
2012-02-21 UP 
2012-02-22 DOWN 
2012-02-23 UP 
2012-02-24 DOWN 
2012-02-27 UP 
2012-02-28 UP 


探索 DataSet 数 据 框 的 内 部 结构 。 使 用 遂 数 str () 探索 作为 R 对 象 的 Dataset 数 据 框 的 内 部 结构 : 


> str(DataSet) 


结果 如 下 : 


'data.frame': 469 obs. of 5 variables: 


$ relativestrengthindex3 : num 54.8 58.5 42.9 57.9 25.4 ... 

$ exponentialMovingAverageDiff: num 0.0329 0.0419 -0.032 0.032 -0.152 ... 

$ MACDsignal : num 7.28 6.96 6.62 6.3 5.93 ... 

$ stochasticoscillator - num 65.5 62.9 59.2 56.3 50.3 ... 

$ binaryclassification : Factor w/ 2 levels "DOWN","UP": 2121221221... 


探索 DataSet 数 据 框 的 维度 。 使 用 dim () BEDAE[BIDataSetZmtERJAEIE, DataSet FARRAIS. RARE 
地 显示 数据 框 有 469 行 数据 和 5 人 列 : 


> dim(DataSet) 

结果 如 下 : 

[1] 469 2 

建立 训练 数据 集 。 数 据 框 Data9et 三 分 之 二 的 元 素 将 被 用 作 训练 数据 集 ， 而 另外 三 分 之 一 的 元 素 将 被 用 作 测 试 数据 集 。 
训练 数据 集 存 储 在 TrainingDataSet 中 : 

> TrainingDataSet «- DataSet[1:312,] 


显示 TrainingDataset 的 值 : 


> TrainingDataSet 


结果 如 下 : 


relativeStrengthindex3 * | exponentialMovingAverageDiff * | MACDsignal * | stochasticOscillator * | binaryClassification * 
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探索 TrainingDataset 数 据 框 的 内 部 结构 。 使 用 函数 str () 探索 作为 R 对 象 的 TrainingDataSet 数 据 框 的 内 部 结构 : 


> str(TrainingDataSet) 


结果 如 下 : 

"'data.frame': 312 obs. of 5 variables: 

$ relativestrengthindex3 : num 54.8 58.5 42.9 57.9 25.4 ... 

$ exponentialMovingAverageDiff: num 0.0329 0.0419 -0.032 0.032 -0.152 ... 

$ MACDsignal : num 7.28 6.96 6.62 6.3 5.93 ... 

$ stochasticoscillator : num 65.5 62.9 59.2 56.3 50.3 ... 

$ binaryclassification : Factor w/ 2 levels "DOWN","UP": 2 1 2 1 2 2 1 2 2 1 ... 


测试 数据 集 存储 在 TestDataSet 中 : 


> TestDataSet «- DataSet[313:469,] 


显示 TestDataSet 的 值 : 


> TestDataSet 


结果 如 下 : 


relativeStrengthindex3 


exponentialMovingAverageDiff 


MACDsignal 


stochasticOscillator 


binaryClassification 


| 2013-05-20 65.325949 0.0730539531 1.98313400 69.6679580 | UP 

| 2013-05-21 78.156846 0.1420359687 2,13036094 72.0639927 | DOWN 

| 2013-05-22 67.458592 0.0680239792 2,25183036 73.9600584 | DOWN 

| 2013-05-23 17.410830 -0.3279840139 2.27747286 69.4201295 | UP 

| 2013-05-24 44.080812 -0.0586560093 2.255.090 65.3480900 | UP 

, 2013-05-28 66.024066 0.1742293272 2,26484286 64.7048951 | DOWN 
2013-05-29 49.601280 -0.00384 71152 2.24360230 63.2583992 | UP 
2013-05-30 63.041750 0.1241019232 2,22047156 63.6817730 | UP 
2013-05-31 81.114361 0.3560679488 2.26183097 65.8115477 | DOWN 
2013-06-03 58.588063 0.0907119659 2.29181066 65.8819964 | DOWN 
2013-06-04 43.695489 -0.0595253561 2.29123360 63.3093314 | DOWN 
2013-06-05 29,805575 -0.1863502374 2.24007639 57.6419193 | DOWN 
2013-06-06 20.482875 -0.2642334916 2.12973132 49.0406161 | UP 
2013-06-07 48.979815 -0.0094889944 2,01314398 42.7848515 | UP 
2013-06-10 62.039679 0.1003406704 1.91329325 39.3458410 | DOWN 
2013-06-11 32.449075 -0.183864395531 1.77933613 32.8078058 | UP 
2013-06-12 45.731641 -0.0376263687 1.64254716 26.5032382 | DOWN 
2013-06-13 29.609063 -0.183850342458 1.47858272 18.2167820 | UP 
2013-06-14 53.284086 0.0299438361 1.33046817 12.2603547 | DOWN 
2013-06-17 47.086977 -0.02003 74426 1.18979644 6.6571619 | UP 
2013-06-18 53.803044 0.0199750383 1.06447974 1.9930456 | UP 
2013-06-19 63.525236 0.0599833589 0.96136615 -0.1580052 | DOWN 


探索 TestDataset 数 据 框 的 内 部 结构 。 使 用 函数 str () 探索 作为 R 对 象 的 TestDataSet 数 据 框 的 内 部 结构 : 


> str(TestDataSet) 


结果 如 下 : 


5 variables: 
: nm 65.3 78.2 67.5 17.4 44.1 ... 

num 0.0731 0.142 0.068 -0.328 -0.0587 ... 
: num 1.98 2.13 2.25 2.28 2.27 ... 
: num 69.7 72.1 74 69.4 65.3 ... 
: Factor w/ 2 levels "DOWN","UP": 


'data.frame' 157 obs. of 
$ “uras aka pues 
$ exponentialMovingAverageDi ff: 
$ MACDsignal 
$ stochasticoscillator 


$ binaryclassification 2112212211... 


第 5 步 : 建立 模型 


使 用 适合 模型 的 函数 rpart () 通过 指定 指标 建立 树 模 型 。 结 果 为 binaryClassification， 使 用 relativeStrengthindex3、 
exponentialMovingAverageDiff、MACDsignal 和 stochasticOscillator 的 求 和 作为 预测 变量 。 data=TrainingDatasSet 表 示 数 


据 框 。cp=0.001 表 示 复 杂 度 参数 。 参 数 的 主要 作用 是 通过 修 部 分 割 来 书 省 计算 时 间 。 结 果 存 储 在 数据 框 DecisionTree 中 : 


> DecisionTree «- 
rpart (binaryClassification-relativeStrengthIndex3texponentialMovingAverageD 
iff-MACDsignalctstochasticOscillator,data-TrainingDataSet, cp-.001) 


绘制 数 模型 。 使 用 函数 prp () 绘制 DecisionTree 数 据 框 。type=2 垂 直 平 移 决策 节点 : 


> prp(DecisionTree,type-2) 


结果 如 下 : 
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显示 数据 框 DecisionTree 的 cp 表 。 使 用 函数 printcp () ，DecisionTree 作 为 输入 人 参数: 


> printcp(DecisionTree) 


结果 如 下 : 


Regression tree: 

rpart(formula = binaryclassification ~ relativestrengthindex3 + 
exponentialMovingAverageDiff + MACDsignal + stochasticoscillator, 
data = TrainingDataSet, cp = 0.001) 


variables actually used in tree construction: 


[1] exponentialMovingAverageDiff MACDsignal stochasticoscillator 


Root node error: 379763/312 - 1217.2 


n- 312 

CP nsplit rel error  xerror xstd 
1 20.6161391 ο 1.000000 1.006621 0.0805080 
2. 0.1385847 1 20.383861 0.425413 0.0258015 
3 0.1279509 2 0.245276 0.239488 0.0171030 
4 0.0234300 3 0.117325 0.148520 0.0100709 
5 0.0184278 4 0.093895 0.112485 0.0088131 
6 0.0139817 5 0.075468 0.093846 0.0074399 
7 0.0114713 6 0.061486 0.090516 0.0073090 
8 0.0109389 7 0.050015 0.083841 0.0068419 
9 0.0024909 8 0.039076 0.055447 0.0044426 
10 0. 0020731 9 0.036585 0.049021 0.0037592 
11 0.0018220 10 20.034512 0.047577 0.0036377 
12 0.0017162 11 20.032690 0.046951 0.0036975 
13 0.0015551 12 0.030973 0.045004 0.0034110 
14 0.0015058 13 20.029418 0.044700 0.0034306 
15 0.0010804 14 0.027913 0.042956 0.0032516 
16 0.0010000 15 20.026832 0.041428 0.0032116 


绘制 树 的 几何 平均 值 。 函 数 plotcp () 提供 了 数据 框 DecisionTree 的 交叉 验证 结果 的 可 视 化 表示 : 


> plotcp (DecisionTree,upper="splits") 


结果 如 下 : 
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第 6 步 : 改进 模型 


修剪 树 后 使 用 函数 prune () 改进 模型 ， 数 据 框 DecisionTree 是 函数 的 输入 参数 。 采 用 最 低 的 交叉 验证 错误 值 (x 错 
ix) , cp=0.041428: 


> PrunedDecisionTree «- prune (DecisionTree,cp=0.041428) 


绘制 树 模型 。 使 用 函数 prp () 绘制 DecisionTree 数 据 框 。type=4 垂 直 平 移 决策 节点 : 


> prp(PrunedDecisionTree, type-4) 


结果 如 下 : 


MACDsign «0.56 


c» e» 
— ον 


> d 


测试 模型 : 


MACDsign < -1.3 


> table (predict (PrunedDecisionTree,TestDataSet), TestDataSet[,5], 
dnn-list('predicted','actual')) 


结果 如 下 : 


actual 
predicted DOWN UP 
DOWN 64 53 
UP 23 17 


6.5 ”朴素 贝 叶 斯 : 预测 股票 走势 方向 


股票 交易 是 统计 人 员 试 图 解决 的 最 具 挑 战 性 的 问题 之 一 。 有 诸多 的 技术 指标 ， 例 如 走势 方向 、 市 场 活力 是 否 缺 之 ， 鳃 利 潜 
波动 ， 以 及 市 场 中 监测 流行 度 的 成 交 量 措施 等 。 这 些 指标 可 为 高 可 靠 性 交易 机 会 创造 策略 。 友 现 技术 指标 之 间 的 关系 可 能 需要 伦 
费 几 天 / 周 / 月 的 时 间 ， 因 此 需要 使 用 诸如 决策 树 之 类 的 高 效 省 时 的 工具 。 决 策 树 的 主要 优点 是 它 是 一 个 强大 且 易 于 解释 的 算法 。 
准备 工作 


我 们 使 用 股票 市 场 的 数据 集 来 搭建 朴素 贝 叶 斯 。 


第 1 步 : 收集 和 摘 述 数据 


数据 集 选 取 美 国 银行 在 2012 年 1 月 1 日 至 2014 年 1 月 1 日 之 间 的 每 日 收盘 价 的 值 。 我 们 将 要 下 载 的 数据 集 可 以 在 以 下 网 址 免费 


获得 : http://yahoo.com。 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 


首先 需要 加 载 以 下 软件 包 : 


> install.packages ("quantmod") 
» install.packages ("lubridate") 
> install.packages ("e1071") 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.3.0 (2016-05-03) 。 
需要 安装 以 上 软件 包 的 相应 库 : 


> library("quantmod") 
> library("lubridate") 
> library("e1071") 


现在 开始 标记 所 需 数 据 时 间 段 的 起 始 时 间 和 结束 时 间 ， 并 下 载 数 据 。 
EEEas.Date () 用 于 将 字符 表示 的 日 期 转换 为 Date 类 对 象 。 


数据 集 的 初始 日 期 存 于 startDate 中 ， 表 示 格 式 为 YYYY-MM-DD: 


> startDate = as.Date("2012-01-01") 


数据 集 的 结束 日 期 存 于 endDate 中 ， 表 示 格 式 为 YYYY-MM-DD: 


> endDate = as.Date("2014-01-01") 


使 用 六 数 getsymbols () 加 载 数据 。 该 尔 数 从 本 地 或 远程 的 多 个 源 加 载 数据 。 数 据 被 提取 并 保存 在 指定 的 env 中 。env 的 默 
认 值 为 .GlobalEnv。AAPL 是 指定 要 加 载 符号 名 称 的 字符 向 量 。src=yahoo 指 定 选 择 源 的 万 法 : 


> getSymbols("AAPL", env = .GlobalEnv, src = "yahoo", from = startDate, 
to = endDate) 


AS of 0.4-0, 'getsymbols' uses env-parent.frame() and 
auto.assign-TRUE by default. 


This behavior will be phased out in 0.5-0 when the call will 
default to use auto.assign-FALSE. getoption("get5ymbols.env") and 
getoptions("getsymbols.auto.assign") are now checked for alternate defaults 


This message is shown once per session and may be disabled by setting 
options("getsymbols.warning4.O0"-FALSE). See ?get5ymbols for more details. 
[1] "AAPL" 


使 用 函数 wda () FGZe—JëlrR8 Z  XBJSdsxERIRIBS. iXESERLA T Ee S TURIBIERRJL. ΑΑΡΙ ΡΕ, label- TRUE 


将 星期 几 显示 为 字符 串 ， 例 如 “星期 日 ”。 结 果 仓 储 在 数据 杠 weekDays 中 : 


> weekDays <- wday (AAPL, label-TRUE) 


fj dweekDayszAdgt, fBFBERgZXxhead () ix[BIweekDaysZidis TER 3L SpA, weekDays(EZJERZAB S8 A SN : 


> head (weekDays) 


结果 如 下 : 


[1] Tues wed Thurs Fri Mon Tues 
Levels: Sun < Mon < Tues < Wed < Thurs < Fri < 5at 


第 3 步 : 准备 变量 构建 数据 集 
计算 开盘 价 和 收盘 价 的 差别 。CI 代 表 收 盘 价 ，Op 代 表 开盘 价 ， 结 果 存储 在 数据 框 cnangelnPrices 中 : 


> changeInPrices <- Cl(AAPL) - Op(AAPI) 


输出 changelnPrices 数 据 框 。 使 用 函数 head () 返回 changelnPrices 数 据 框 的 头 部 数据 ，changelnPrices 作 为 函数 的 输入 
参数 : 


v 


» head(changeInPrices) 


结果 如 下 : 


AAPL.Close 
2012-01-03 1.830002 
2012-01-04 3.439999 
2012-01-05 3.079990 
2012-01-06 2.629994 
2012-01-09  -3./69992 
2012-01-10  -2.669994 


探索 数据 框 changelnPrices 的 概要 。summary () ΗΕ ΕΙ f — 32v EZECH SR, LASERVSSTEChangelnPricesB Star 
要 结果 : 


> summary (changeInPrices) 


结果 如 下 : 
Index AAPL.Close 
Min. : 2012-01-03 Min. :—30.1200 


lst Qu.:2012-07-02 lst Qu.: -5.0075 
Median :2013-01-02 Median : -0.1500 


Mean :2013-01-01 Mean : -0.5479 
3rd Qu. :2013-07-02 3rd Qu.: 3.7325 
Max. : 2013-12-31 Max. : 30.7600 


探索 changelnPrices 数 据 框 的 维度 。 使 用 dim () 函数 返回 changelnPrices 数 据 框 的 维度 ，changelnPrices 作 为 六 数 的 输 
入 参数 。 返 回 结果 清楚 地 显示 数据 框 有 502 行 数据 和 1 列 : 


> dim(changeInPrices) 


结果 如 下 : 


[1] 502 1 


8/8 πολ, BRENifelse () 返回 值 为 测试 表达 式 ， 它 本 身 是 一 个 向 量 ， 并 且 与 测试 表达 式 的 长 度 相同 。 如 果 测 试 表 
达 式 的 相应 值 为 TRUE， 则 返回 的 向 量具 有 来 自 x 的 元 素 ， 如 果 测 试 表达 式 的 相应 值 为 FALSE， 则 具有 来 自 y 的 元 素 。 


这 里 ，changelnPrices>0 是 测试 闵 数 ， 它 将 以 逻辑 模式 进行 测试 。 使 用 参数 UP 和 DOWN 执 行 逻 辑 测试 ， 然 后 将 结果 存储 
在 数据 框 binaryClassification 中 : 


> binaryClassification <- ifelse(changeInPrices»0, "UP", "DOWN") 
显示 binaryClassification 的 值 : 


> binaryClassification 


结果 如 下 : 


AAPL.Close 
2012-01-03 "uP" 
2012-01-04 "uP" 
2012-01-05 "UP™ 
2012-01-06 "UP™ 
2012-01-09 "DOWN" 
2012-01-10 "DOWN" 
2012-01-11 "DOWN" 
2012-01-12 "DOWN" 
2012-01-13 "uP" 
2012-01-17 "UP" 
2012-01-18 "UP" 
2012-01-19 "DOWN" 
2012-01-20 "DOWN" 
2012-01-23 "uP" 
2012-01-24 "DOWN" 
2012-01-25 "DOWN" 
2012-01-26 "DOWN" 
2012-01-27 "UP" 
2012-01-30 "uP" 
2012-01-31 “up” 
2012-02-01 "DOWN" 
2012-02-02 "DOWN" 
2012-02-03 "UP" 


2012-02-06 "UP" 
2012-02-07 "UP" 
2012-02-08 "UP" 
2012-02-09 “UP™ 
2012-02-10 "uP" 
2012-02-13 "uP" 


IREszmtEbinaryClassificationRSIEEs2, BEZXsummary () BEAD f — 57 ta ESL E, ΞΕΡΕΤΕ 
binaryClassification 的 概要 结 


> summary (binaryClassification) 


结果 如 下 : 


Index AAPL.Close 
Min. :2012-01-03 DOWN : 257 
15τ Qu. 2012-07-02 UP  :245 
Median :2013-01-02 
Mean :2013-01-01 
3rd Qu. :2013-07-02 
Max. :2013-12-31 


DEAE., F-J Za siapa SE, fBRHBRZXdata.frame () 创建 数据 框 。 这 些 变量 共享 和 矩阵 的 属性 。 
作为 参数 传递 给 data.frame () 的 变量 有 weekDays 和 binaryClassification。 结 果 存 储 在 数据 框 AAPLDataSet 中 : 


> AAPLDataSet «- data.frame(weekDays,binaryClassification) 


显示 AAPLDataSet 的 值 : 


> AAPLDataSet 


结果 如 下 : 

weekDays AAPL.Close 
2012-01-03 Tues UP 
2012-01-04 wed UP 
2012-01-05 Thurs UP 
2012-01-06 Fri UP 
2012-01-09 Mon DOWN 
2012-01-10 Tues DOWN 
2012-01-11 wed DOWN 
2012-01-12 Thurs DOWN 
2012-01-13 Fri UP 
2012-01-17 Tues UP 
2012-01-18 wed UP 
2012-01-19 Thurs DOWN 
2012-01-20 Fri DOWN 
2012-01-23 Mon UP 
2012-01-24 Tues DOWN 
2012-01-25 wed DOWN 
2012-01-26 Thurs DOWN 
2012-01-27 Fri UP 
2012-01-30 Mon UP 
2012-01-31 Tues UP 
2012-02-01 wed DOWN 
2012-02-02 Thurs DOWN 
2012-02-03 Fri UP 
2012-02-06 Mon UP 
2012-02-07 Tues UP 
2012-02-08 wed UP 
2012-02-09 Thurs UP 
2012-02-10 Fri UP 


输出 AAPLDataSet 数 据 框 。 使 用 水 数 head () 返回 AAPLDataset 数 据 框 的 头 部 数据 ，AAPLDataset 作 为 为数 的 输入 参 


> head (AAPLDataSet) 


结果 如 下 : 

weekDays AAPL.Close 
2012-01-03 Tues UP 
2012-01-04 wed UP 
2012-01-05 Thurs UP 
2012-01-06 Fri UP 
2012-01-09 Mon DOWN 
2012-01-10 Tues DOWN 


Ó` 


探索 AAPLData9et 数 据 框 的 维度 。 使 用 dim () ΒΗΞΙΙΚΙΗΙΑΑΡΙ ΡαίαςαεΙᾷΙΡΙΕΗΥΖΒΕΕ, AAPLDataSet/E7jPRZA BN 


数 。 返 回 结 果 清 楚 地 显示 数据 框 有 502 行 数据 和 2 列 : 


> dim(AAPLDataSet) 


结果 如 下 : 


[1] 502 2 


第 4 步 : 建立 模型 
通过 指定 指标 构建 朴素 贝 叶 斯 分 类 器 。 水 数 naiveBayes () 使 用 贝 叶 斯 规则 来 计算 给 定 独立 预测 因子 变量 的 一 组 变量 集 的 
后 验 概 率 。 该 函数 假设 测量 的 预测 因子 服从 高 斯 分 布 。 函 数 输出 为 NaiveBayesclassifier， 其 中 自 变量 是 AAPLDataset[，1]， 


变量 是 AAPLDataSet[，2]: 


> NaiveBayesclassifier <- naiveBayes(AAPLDataSet[,1], AAPLDataSet[,2]) 


显示 NaiveBayesclassifier 的 值 : 


> NaiveBayesclassifier 


结果 如 下 : 


Naive Bayes Classifier for Discrete Predictors 


Call: 
naiveBayes.default(x = AAPLDataset[, 1], y = AAPLDatasSet[, 2]) 


A-priori probabilities: 
AAPLDataSet[, 2] 

DOWN UP 
0.5119522 0.4880478 


conditional probabilities: 
x 
AAPLDatasert[, 2] sun Mon Tues wed Thurs Fri Sat 
DOWN 0.0000000 0.1284047 0.1906615 0.2295720 0.2373541 0.2140078 0.0000000 
UP 0.0000000 0.2530612 0.2163265 0.1755102 0.1632653 0.1918367 0.0000000 


结果 基于 整个 数据 集 显示 价格 上 涨 或 下 降 的 概率 。 这 是 看 跌 的 本 质 。 
第 5 步 : 为 新 的 改进 模型 创建 数据 


制定 一 个 成 熟 的 策略 预测 未 来 (超过 一 天 ) 。 计 算 一 个 5 年 模型 的 移动 平均 线 。EMA () 使 用 符号 AAPL 代 表 价 格 系列 。 
n=5 表 示 平 均 时 | 间 ， 结 果 和 存储 在 数据 框 e&xponentialMovingAverage5 中 : 


> exponentialMovingAverage5 «- EMA(Op(AAPL),n = 5) 


显示 exponentialMovingAverage5 的 值 : 


> exponentialMovingAverage5 


结果 如 下 : 


2012-01-03 
2012-01-04 
2012-01-05 
2012-01-06 
2012-01-09 
2012-01-10 
2012-01-11 
2012-01-12 
2012-01-13 
2012-01-17 
2012-01-18 
2012-01-19 
2012-01-20 
2012-01-23 
2012-01-24 
2012-01-25 
2012-01-26 
2012-01-27 
2012-01-30 
2012-01-31 
2012-02-01 
2012-02-02 
2012-02-03 
2012-02-06 
2012-02-07 
2012-02-08 
2012-02-09 
2012-02-10 
2012-02-13 
2012-02-14 
2012-02-15 
2012-02-16 
2012-02-17 
2012-02-21 


415.9240 
419.2527 
420. 3951 
421.0234 
420.5823 
421. 7882 
423. 5121 
425.7247 
426. 3132 
425.0988 
425.0992 
434. 8795 
439. 3730 
441.0286 
442.5891 
446.9227 
450.7518 
452.4679 
454.0786 
455. 5124 
458.7583 
462. 6722 
468. 7015 
476.1210 
483.9240 
490. 8360 
498. 6440 
496. 2627 
498. 5451 
501.3234 


使 用 函数 summary () 探索 价格 变化 的 概要 ， 该 函数 提供 一 系列 摘 述 性 统计 信息 ， 以 生成 数据 框 
exponentialMovingAverage5 的 概要 结果 : 


> summary (exponentialMovingAverage5) 


结果 如 下 : 


EMA 
Min. :400.1 
lst Qu.:454.5 
Median :522.1 


Index 
Min. :2012-01-03 
lst Qu. :2012-07-02 
Median :2013-01-02 


Mean :2013-01-01 Mean :525.0 

3rd Qu. :2013-07-02 3rd Qu. :581.8 

Max. :2013-12-31 Max. :697.8 
NA 5 :4 


计算 一 个 10 年 模型 的 移动 平均 线 。 
EMA () 使 用 符号 AAPL 代 表 价 格 系 列 。n=10 表 示 平 均 时 间 ， 结 果 和 存储 在 数据 框 exponential-MovingAverage10 中 : 


> exponentialMovingAverage10 <- EMA(Op(AAPL),n = 10) 


显示 exponentialMovingAverage10 的 值 : 


> exponentialMovingAverage10 


结果 如 下 : 


2012-01-03 
2012-01-04 
2012-01-05 
2012-01-06 
2012-01-09 
2012-01-10 
2012-01-11 
2012-01-12 
2012-01-13 
2012-01-17 
2012-01-18 
2012-01-19 
2012-01-20 
2012-01-23 
2012-01-24 
2012-01-25 
2012-01-26 
2012-01-27 
2012-01-30 
2012-01-31 
2012-02-01 
2012-02-02 
2012-02-03 
2012-02-06 
2012-02-07 
2012-02-08 
2012-02-09 
2012-02-10 
2012-02-13 
2012-02-14 
2012-02-15 
2012-02-16 
2012-02-17 
2012-02-21 
2012-02-22 


ΕΕΕΕΕΕΕΕΕΣ 


436.7938 
440. 2112 
443. 5201 
445.7710 
447.8672 
449. 7786 
452.5916 
455.8477 
A60. 3772 
465.9377 
472.0454 
477.9753 
484.5725 
485. 8321 
488.9735 
492. 2292 
496. 0203 


使 用 函数 summary () 探索 价格 变化 的 概要 ， 该 阔 数 提供 一 系列 描述 性 统计 信息 ， 以 生成 数据 框 
exponentialMovingAverage10 的 概要 结果 : 


> summary (exponentialMovingAverage10) 


结果 如 下 : 
Index EMA 
Min. : 2012-01-03 Min. :408. 2 
lst Qu.:2012-07-02 lst Qu.:452.5 
Median :2013-01-02 Median :521.4 
Mean : 2013-01-01 Mean :525.3 
3rd Qu. :2013-07-02 3rd Qu. :579.2 
Max. :2013-12-31 Max. : 690.9 
NA'S :9 


探索 exponentialMovingAverage10 数 据 框 的 维度 。 使 用 dim () 函数 返回 exponentialMoving-Average10 数 据 框 的 维 


上 度 ，exponentialMovingAverage10 作 为 为 数 的 输入 人 参数。 返回 结果 清楚 地 显示 数据 框 有 502 行 数据 和 1 列 : 


> dim(exponentialMovingAverage10) 


结果 如 下 : 


[1] 502 1 


计算 exponentialMovingAverage5 和 exponentialMovingAverage10 的 区 别 : 


> exponentialMovingAverageDiff «- exponentialMovingAverage5 - 
exponentialMovingAverage10 


显示 exponentialMovingAverageDiff 的 值 : 


> exponentialMovingAverageDiff 


结果 如 下 : 

ΕΜΑ 
2012-01-03 NA 
2012-01-04 ΝΑ 
2012-01-05 NA 
2012-01-06 NA 
2012-01-09 NA 
2012-01-10 NA 
2012-01-11 NA 
2012-01-12 NA 
2012-01-13 NA 
2012-01-17 2. 349176968 
2012-01-18 2. 705663418 
2012-01-19 3.219465214 
2012-01-20 2.901570272 
2012-01-23 1.822016650 
2012-01-24 1.490928211 
2012-01-25 5. 665426292 
2012-01-26 6. 677857137 
2012-01-27 6. 216280801 
2012-01-30 5. 795342146 
2012-01-31 6. 711473809 
2012-02-01 7 . 231704486 
2012-02-02 6. 6096875947 
2012-02-03 6. 211406080 
2012-02-06 5.733787451 
2012-02-07 6. 166676687 
2012-02-08 6. 824514652 
2012-02-09 8. 324272958 
2012-02-10 10.183279127 
2012-02-13 11.878594211 
2012-02-14 12.860669002 
2012-02-15 14.071458191 
2012-02-16 10.430590131 
2012-02-17 9. 571593757 
2012-02-21 η 094168840 


使 用 函数 sSummary () 探索 价格 变化 的 概要 ， 该 阔 数 提供 一 系列 描述 性 统计 信息 ， 以 生成 数据 框 
exponentialMovingAverageDiff 的 概要 结果 : 


> summary(exponentialMovingAverageDiff) 


结果 如 下 : 


Index EMA 
Min. 2012-01-03 Min. --17.3855 


ΝΑ 5 


lst Qu. 2012-07-02 lst Qu.: -4.3898 
Median :2013-01-02 Median : 1.2982 
Mean :2013-01-01 Mean : 0.7234 
3rd Qu. :2013-07-02 3rd Qu.: 5.5539 
Max. :2013-12-31 Max. : 15.0582 


9 


保留 数据 框 exponentialMovingAverageDiff 两 位 有 效 数字 : 


> exponentialMovingAverageDiffRound <- 
round(exponentialMovingAverageDiff, 2) 


使 用 函数 summary () 探索 价格 变化 的 概要 ， 该 函数 提供 一 系列 摘 述 性 统计 信息 ， 以 生成 数据 框 
exponentialMovingAverageDiffRound 的 概要 结 


> summary(exponentialMovingAverageDiffRound) 


结果 如 下 : 


Index EMA 
Min. :2012-01-03 Min. :-17.3900 
1st Qu.-:2012-0/-02 ist Qu.: -4.3900 
Median :2013-01-02 Median : 1.3000 
Mean :2013-01-01 Mean : 0.7233 
3rd Qu. :2013-07-02 3rd Qu.: 5.5500 
Max. :2013-12-31 Max. : 15. 0600 


第 6 步 : 改进 模型 


创建 待 用 数据 集 。 基 于 紧密 耦合 的 变量 集 ， 使 用 函数 data.frame () 创建 数据 框 。 这 些 变 量 共享 和 矩 阵 的 属性 。 作 为 参数 传 
递 给 data.frame () 的 变量 有 weekDays、exponentialMovingAverageDiffRound 和 binaryClassification。 结 果 存 储 在 数据 框 
AAPLDataSetNew 中 : 


> AAPLDataSetNew <- 
data.frame(weekDays,exponentialMovingAverageDiffRound, 
binaryClassification) 


显示 AAPLDataSetNew 的 值 : 


> AAPLDataSetNew 


结果 如 下 : 


2012-01-03 
2012-01-04 
2012-01-05 
2012-01-06 
2012-01-09 
2012-01-10 
2012-01-11 
2012-01-12 
2012-01-13 
2012-01-17 
2012-01-18 
2012-01-19 
2012-01-20 
2012-01-23 
2012-01-24 
2012-01-25 
2012-01-26 
2012-01-27 
2012-01-30 
2012-01-31 
2012-02-01 
2012-02-02 
2012-02-03 
2012-02-06 
2012-02-07 
2012-02-08 
2012-02-09 
2012-02-10 
2012-02-13 
2012-02-14 
2012-02-15 
2012-02-16 
2012-02-17 
2012-02-21 


weekDays 


Tues 
wed 
Thurs 
Fri 
Mon 
Tues 
wed 
Thurs 
Fri 
Tues 
wed 
Thurs 
Fri 
Mon 
Tues 
wed 
Thurs 
Fri 
Mon 
Tues 
wed 
Thurs 
Fri 
Mon 
Tues 
wed 
Thurs 
Fri 
Mon 
Tues 
wed 
Thurs 
Fri 
Tues 


EMA AAPL.Close 
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8.32 
10.18 
11.88 
12.86 
14.07 
10.43 

9.57 

9.09 


UP 
UP 
UP 
UP 
DOWN 
DOWN 


使 用 函数 summary () RRES, ZARE ARTES SR, LAfERREURAEAAPLDataSetNewRSIBse 


dc EB. 
结果 : 


> summary (AAPLDataSetNew) 


结果 如 下 : 
weekDays EMA AAPL.Close 
Sun - O0 Min. L—17. 3900 DOWN : 257 
Mon - 95 1st Qu.: -4.3900 UP : 245 
Tues :102 Median : 31.3000 
wed  :102 Mean : 0.7233 
Thurs :101 3rd Qu.:  Á 5.5500 
Fri :102 Max. : 15.0600 
Sat -: ο NA ` S : 9 


> AAPLDataSetNew «- AAPLDataSetNew[-c(1:10),] 


结果 如 下 : 


weekDays EMA AAPL.Close 


2012-01-18 wed 2.71 UP 
2012-01-19 Thurs 3.22 DOWN 
2012-01-20 Fri 2.90 DOWN 
2012-01-23 Mon 1.82 UP 
2012-01-24 Tues 1.49 DOWN 
2012-01-25 wed 5.67 DOWN 
2012-01-26 Thurs 6.68 DOWN 
2012-01-27 Fri ο. 22 UP 
2012-01-30 Mon 5.80 UP 
2012-01-31 Tues 6. 71 UP 
2012-02-01 wed 7.23 DOWN 
2012-02-02 Thurs 6.70 DOWN 
2012-02-03 Fri 6.21 UP 
2012-02-06 Mon 5.73 UP 
2012-02-07 Tues 6.17 UP 
2012-02-08 wed 6.82 UP 
2012-02-09 Thurs 8.32 UP 
2012-02-10 Fri 10.18 UP 
2012-02-13 Mon 11.88 UP 
2012-02-14 Tues 12.86 UP 
2012-02-15 wed 14.07 DOWN 
2012-02-16 Thurs 10.43 UP 
2012-02-17 Fr i 0.57 DOWN 
2012-02-21 Tues 9.09 UP 
2012-02-22 wed 0.22 DOWN 
2012-02-23 Thurs 90.04 UP 
2012-02-24 Fri 0.08 UP 
2012-02-27 Mon 5. 51 UP 
2012-02-28 Tues 9.13 UP 
2012-02-29 wed 10.81 UP 
2012-03-01 Thurs 312.08 DOWN 
2012-03-02 Fri 311.44 UP 
2012-03-05 Mon 10.58 DOWN 
2012-03-06 Tues 6.17 UP 


使 用 函数 summary () PRESÜTSSEHCBSIBESE, ZARE ARTES SR, LAfERRÉNIRAEAAPLDataSetNewRSImse 


+A. 
结果 : 


> summary (AAPLDataSetNew) 


结果 如 下 : 

weekDays EMA AAPL.Close 
sun : O Min. :-17.390 DOWN :253 
Mon .: 94 lst Qu.: -4.395 UP :239 
Tues : 99 Median : 1.285 

wed .:100 Mean = 0.720 

Thurs: 99 3rd Qu.: 5.553 

Fri :100 Max. : 15.060 


sat -: Ὁ 


探索 AAPLDataSetNew 数 据 框 的 维度 。 使 用 dim () 函数 返回 AAPLDatasSetNew 数 据 框 的 维度 ，AAPLDataSsetNew 作 为 
国 数 的 输入 参数 。 返 回 结果 清楚 地 显示 数据 框 有 492 行 数据 和 3 列 : 


> dim(AAPLDataSetNew) 


结果 如 下 : 
[1] 492 3 
建立 训练 数据 集 。 数 据 框 AAPLDataSetNew 三 分 之 二 的 元 素 将 被 用 作 训练 数据 集 ， 而 另外 三 分 之 一 的 元 素 将 被 用 作 测试 数 








据 集 。 


i 





练 数据 集 存储 在 trainingDataSet 中 : 


> trainingDataSet «- AAPLDataSetNew[1:328,] 


探索 trainingDataSet 数 据 框 的 维度 。 使 用 dim () 函数 返回 trainingDatasSet 数 据 框 的 维度 ，trainingDatasSet 作 为 函数 的 
输入 参数 。 返 回 结果 清楚 地 显示 数据 框 有 328 行 数据 和 3 列 : 


> dim(trainingDataSet) 


结果 如 下 : 

[1] 328 3 

[ἘΠΕ ἔΝουιπιπηατγ () PRESÜTTESETLBSIISE, ZAARA, LSERkAMstitrainingDataSetB tree 
c 


> summary (trainingDataSet) 


结果 如 下 : 


weekDays EMA AAPL.Close 
Sun : 0 Min. --17. 3900 DOWN :171 
Mon  :62 lst Qu.: -5.5075 UP  :157 
Tues :65 Median : 30.7800 

wed  :68 Mean : 0.1318 

Thurs:67 3rd Qu.: 5.8125 

Fri :66 Max. : 15.0600 

sat : 0 


测试 数据 集 存储 在 数据 框 TestDataSet 中 : 


> TestDataSet <- AAPLDataSetNew[329:492,] 


探索 TestDataSet 数 据 框 的 维度 。 使 用 dim () AŽ0RE]TestDataSetžģm EAE, TestDataSet(/E7ZJERZAB JAN SS. K 
回 结果 清楚 地 显示 数据 框 有 164 行 数据 和 3 列 |: 


> dim(TestDataSet) 
结果 如 下 : 


[1] 164 3 


> summary (TestDataSet) 


结果 如 下 : 
weekDays EMA AAPL.Close 
Sun : O0 Min. :-10.470 . DOWN:82 


Mon :32 lst Qu.: -0.535 UP :82 
Tues :34 Median : 1.630 


wed  :32 Mean : 1.896 
Thurs :32 3rd Qu.: 4.418 
Fri :34 Max. * 11.940 
sat LU 


EIS TEXETEENPAEER NER D ERAT2ERR. BÉEXnaiveBayes () 使 用 贝 叶 斯 规则 来 计算 给 定 独立 预测 因子 变量 的 一 组 变量 集 的 
后 验 概率 。 该 函数 假设 测量 的 预测 因子 服从 高 斯 分 布 。 


函数 输出 为 exponentialMovingAverageDiffRoundModel， 其 中 上 自 变量 是 trainingDataSet[，1: 2]， 因 变量 是 
trainingDataSet[, 3]: 


> exponentialMovingAverageDiffRoundModel <- 
naiveBayes(trainingDataSet[,1:2],trainingDataSet[,3]) 


显示 exponentialMovingAverageDiffRoundModelI 的 值 : 


> exponentialMovingAverageDiffRoundModel 


结果 如 下 : 


Naive Bayes Classifier for Discrete Predictors 
call: 
naiveBayes.default(x = trainingDataSet[, 1:2], y = trainingDataset[, 
31} 
A-priori probabilities: 
trainingDataSet[, 3] 
DOWN UP 
0. 5213415 0.4786585 
conditional probabilities: 
weekDays 
trainingDataset[, 3] sun Mon Tues wed Thurs Fr i Sat 
DOWN 0.0000000 0.1169591 0.1871345 0.2514620 0.2514620 0.1929825 0.0000000 
UP 0. 0000000 0.2675159 0.2101911 0.1592357 0.1528662 0.2101911 0.0000000 
EMA 
trainingDataSet[, 3] [.1] [,2] 


DOWN -0. 2464912 6.938301 
UP 0. 5437580 7.209192 


测试 结果 : 


> table(predict(exponentialMovingAverageDiffRoundModel,TestDataSet), 
TestDataSet[,3],dnn-list('Predicted',' 'Actual')) 


结果 如 下 : 


Actual 
Predicted DOWN UP 
DOWN 46 49 
UP 36 33 


6.6 随机 森林 : 仙 币 交 易 东 上 略 


进行 技术 分 析 可 以 科学 地 实现 预测 外 汇市 场 未 来 价格 走势 的 目标 。 人 外 汇 交 易 者 根据 多 种 技术 分 析 (如 市 场 走势 、 数 量 、 范 
围 、 支 持 和 阻力 水 平 、 图 表 模 式 和 指标 ) 制定 策略 ， 并 使 用 不 同 的 时 | 间 表 进行 多 时 间 分 析 。 根 据 过 去 市 场 行为 的 统计 ， 如 过 去 的 
价格 和 过 去 的 数量 ,创建 了 评估 资产 所 需 的 技术 分 析 策 略 。 分 析 的 主要 目标 不 是 衡量 资产 的 基本 价值 ， 而 是 根据 历史 业 续 来 计算 
市 场 的 未 来 业绩 。 


准备 工作 


我 们 使 用 美元 和 英镑 的 数据 集 来 搭建 随机 森林。 


第 1 步 : 收集 和 摘 述 数据 


选用 的 数据 集 PoundDollar.csv 是 标准 格式 数据 集 ， 和 存储 5257 行 数据 和 6 个 变量 ， 其 中 数值 型 变量 包括 : 


: Date 
"Open 
: High 
: Low 
: Close 


: Volume 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 


首先 需要 加 载 以 下 软件 包 : 


> install.packages ("quantmod") 
> install.packages ("randomForest") 
> install.packages("Hmisc") 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.3.0 (2016-05-03) 。 


需要 安 六 以 上 软件 包 的 相应 库 : 


> library("quantmod") 
> library("randomForest") 
> library("Hmisc") 


现在 开始 探索 数据 并 理解 参数 之 间 的 关系 。 我 们 导入 PoundDollar.csv 数 据 集 ， 并 保存 为 PoundDollar 数 据 框 : 


> PoundDollar «- read.csv("d:/PoundDollar.csv") 


tj PoundDollarZidisfE, fsFHBEXhead () 返回 PoundDollar 数 据 框 的 头 部 数据 ，PoundDollar 作 为 函数 的 输入 参数 : 


> head(PoundDollar) 


结果 如 下 : 

Χ Date Open High LOW 
11 1/2/12 6:00 1.55051 1.55411 1.54845 1 
2 2 1/2/12 10:00 1.55170 1.55230 1.54746 1 
3 3 1/2/12 14:00 1.54797 1.55147 1.54668 1 
4 4 1/2/12 18:00 1.55036 1.55155 1.54810 1 
5 5 1/2/12 22:00 1.55095 1.55342 1.54967 1 
66 1/3/12 2:00 1.55272 1.55547 1.55200 1 


Close volume 


.55170 
. 54797 
. 55036 
. 55095 
.55272 
. 55457 


4803 
2263 
2375 
1767 
4271 
4383 


输出 PoundDollar 数 据 框 的 概要 。summary () 尔 数 是 一 个 
PoundDollar 数 据 框 作为 summary () 函数 的 输入 参数 : 


多 用 


通用 函数 ， 提 供与 单个 对 象 或 数据 框 相 天 的 数据 概要 。 


> summary (PoundDollar) 


结果 如 下 : 
其 Date Open High Low Close volume 

Min. 1 1/10/12 10:00: 1 Min. :1.459 Min. :1.463 Min :1.456 Min :1.459 Min. 

1st Qu. :1315 1/10/12 14:00: 1 1st Qu.:1.550 1st Qu.:1.552 1st Qu.:1.548 1st Qu.:1.550 ist Qu.: 7106 
median :2629 1/10/12 18:00: 1 Median :1.588 Median :1.590 Median :1.586 Median :1.588  J Median : 14113 
Mean :2629 1/10/12 2:00 : 1 Mean :1. 590 Mean :1. 592 Mean :1. 588 Mean :1. 590 Mean : 17938 
3rd Qu. :3943 1/10/12 22:00: 1 3rd Qu. :1.626 3rd Qu. :1.627 3rd Qu. :1.624 3rd Qu. :1.626 3rd Qu.: 23321 
Max. 25257 1/10/12 6:00 : 1 Max. -1.717 Max. :1.719 Max. :1.716 Max. i Max. :155384 

(other) :5251 


探索 PoundDollar 数 据 框 的 维度 。 使 用 dim () μΗΒΠΕΙΗΡοωπαΏοΙἰαγβΙβ/ΞΕΗΝΕΒΗΕΕ, PoundDollarfEZ3ESZkBSss A S2. 


返回 结果 清楚 地 显示 数据 框 有 5257 行 数据 和 7 列 : 


> dim(PoundDollar) 


结果 如 下 : 
[1] 5257 7 
第 3 步 : 准备 变量 构建 数据 集 


函数 as.POSIXIt () 操作 对 象 来 表示 日 期 和 时 间 ，PoundDollar 作 为 函数 的 参数 传递 。 
%M 表 示 日 期 时 间 格 式 ， 结 果 存 储 在 数据 框 DateAndTime 中 : 


表示 日 历 日 期 和 时 间 。 
format= "96m/96d/96y96H : 


> DateAndTime <- as.POSIXl1t (PoundDollar[,2],format-2"$m/$d/$y %H:%M") 


捕获 变量 High、Low 和 Close: 


> HighLowClose «- PoundDollar[,4:6] 


数据 框 PoundDollar 基 于 第 4、5、6 列 捕获 了 变量 High、Low 和 和 Close。 


输出 HighLowClose 数 据 框 。 使 用 遂 数 head () 返回 HighLowClose 数 据 框 的 头 部 数据 ，HighLowClose 人 作为 为 数 的 输入 参 


> head(HighLowClose) 


结果 如 下 : 

High Low Close 
1 1.55411 1.54845 1.551/0 
2 1.55230 1.54746 1.54797 
3 1.55147 1.54668 1.55036 
4 1.55155 1.54810 1.55095 
3 1.55342 1.54967 1.55272 
6 1.55547 1.55200 1.55457 


输出 PoundDollar 数 据 框 的 概要 。summary () EREAZE— 
PoundDollar 数 据 框 为 summary () Ë 


> summary (HighLowClose) 


结果 如 下 : 


个 多 用 途 通用 立 数 ， 提 供与 早 个 对 和 象 或 数据 框 相关 的 数据 概要 。 


函数 的 输入 参数 : 


High Low close 

:1. 463 Min. :1.456 Min. :1.459 
lst Qu.:1.552 lst Qu.:1.548 ist Qu.:1.550 
Median :1.590 Median :1.586 Median :1.588 


Min. 1 
1 
1 
Mean :1. 592 Mean :1.588 Mean :1. 590 
1 
1 


3rd Qu. :1.627 3rd Qu. :1. 624 3rd Qu. :1. 626 


Max. ει. 719 Max. :1. 716 Max. A mami 


探索 HighLowClose 数 据 框 的 内 部 结构 。 使 用 函数 str () 探索 作为 R 对 象 的 HighLowClose 数 据 框 的 内 部 结构 : 


> str(HighLowClose) 


结果 如 下 : 


'data.frame': 5257 obs. of 3 variables: 
$ High : num 1.55 1.55 1.55 1.55 1.55 ... 
$ Low : num 1.55 1.55 1.55 1.55 1.55 ... 
$ close: num 1.55 1.55 1.55 1.55 1.55 ... 


Sl EFE MESE. Ες Zaa siapa fE, fFHBRÉMdata.frame () 创建 数据 框 。 这 些 变量 共享 矩阵 的 属性 。 作 为 参数 传 
递 给 data.frame () 的 变量 为 HighLowClose。 结 果 存 储 在 数据 框 HighLowClosets 中 。row.names=DateAndTime 表 示 指 定 要 
用 作 行 名 称 的 列 的 单个 整数 字符 串 ， 其 结果 存储 在 HighLowClose 数 据 框 中 : 


> HighLowClosets «- data.frame (HighLowClose, row.names=DateAndTime) 


使 用 提供 项 目 分 析 的 国 数 describe () 描述 数据 集 ，HighLowClosets 为 遂 数 的 输入 参数 : 


> describe (HighLowClosets) 


士 
结果 如 下 : 
HighLowclosets 
3 variables 5257 Observations 
High 
n missing unique Info Mean .05 -10 .25 -50 «73 «90 -95 
5257 0 4581 1 1.592 1. 504 1.518 1.552 1.590 1.627 1.676 1.689 


n missing unique Info Mean .05 .10 . 25 . 50 . 75 . 90 .95 
5237 0 4590 1 1.588 1.501 1.513 1.548 1.586 1.624 1.673 1.686 


lowest : 1.456 1.458 1.459 1.460 1.460, highest: 1.715 1.715 1.715 1.716 1.716 


n missing unique Info Mean .05 .10 .25 .50 .75 . 90 .95 
5257 0 4610 1 1.59 1. 502 1.516 1.550 1.588 1.626 1.674 1.687 


lowest : 1.459 1.460 1.461 1.462 1.462, highest: 1.716 1.716 1.717 1.717 1.717 


使 用 函数 as.xts () 创建 时 间 序列 对 象 ， 可 以 将 任意 类 的 数据 对 象 转换 为 ts 类， 而 不 会 丢失 原始 格式 的 任何 属性 。 
HighLowClosets 作 为 输入 函数 的 输入 参数 : 


> HighLowClosexts «- as.xts(HighLowClosets) 


计算 布 林 线 (Bollinger Bands) . PARECERES, AARRE. PIREA RIHMA 
有 可 能 赵 癌 于 平均 水 平 的 逻辑 运作 的 ， 因 此 当 它 偏离 太 远 时 ， 例 如 距离 两 个 标准 差 ， 便 回溯 到 其 移动 平均 线 。 使 用 BBands () 
肖 数 用 于 计算 布 林 线 。HighLowClosexts 作 为 立 数 的 输入 参数 ， 该 对象 被 更 改 为 矩阵 ， 其 中 包含 最 高 -最 低 - 收 盘 价格 。n=20 表 
示 移 动 平均 数 的 周期 数 。SM 人 A 命名 要 调用 的 辫 数 。sd=2 表 示 两 个 标准 偏差 : 


> BollingerBands «- BBands (HighLowClosexts,n-20,SMA,sd-2) 


使 用 提供 项 目 分 析 的 函数 describe () 摘 述 数据 集 ，BollingerBands 为 为 数 的 输入 人 参数: 


> describe (BollingerBands) 


士 ° 
结果 如 下 : 
BollingerBands 
4 Variables 5257 Observations 
dn 
n missing unique Info Mean .05 .10 .25 .50 .75 .90 .95 
5238 19 5238 Ez 1.582 1.489 1. 506 1.541 1.581 1.618 1.669 1.681 


lowest : 1.451 1.451 1.452 1.452 1.453, highest: 1.713 1.713 1.713 1.713 1.713 


n missing unique Info Mean .05 .10 .25 -50 -75 - 90 -95 
5238 19 5235 2 1.591 1.504 1.515 1.551 1.588 1.624 1.675 1.687 


lowest : 1.467 1.467 1.467 1.467 1.467, highest: 1.715 1.715 1.715 1.715 1.715 


n missing unique Info Mean .05 .10 .25 - 50 -75 - 90 -95 
5238 19 3238 £ 1.599 1.516 1.525 1.559 1.597 1.633 1.681 1.692 


lowest : 1.476 1.477 1.477 1.477 1.478, highest: 1.720 1.721 1.721 1.721 1.721 


n missing unique Info Mean .05 -10 -25 .50 -75 . 90 .95 
5238 19 5238 1 0.5018 -0.03586 0.04628 0.21201 0.50380 0.78954 0.94882 1.03015 


lowest : -0.3462 -0.3427 -0.3341 -0.3166 -0.2988, highest: 1.3657 1.3718 1.3738 1.3972 1.4310 


构建 上 限 : 


> Upper <- BollingerBands$up - HighLowClosexts$Close 


输出 Upper 数 据 框 的 概要 。summary () AAE T 29 ARBAA, ERRANAK A. Upper 
效 据 框 作为 Summary () 函数 的 输入 参数 : 


> summary (Upper) 


结果 如 下 : 


Index up 

Min. :-0.012491 
1st Qu.: 0.002766 
: 0.006554 


332338 
8 š Ñ ë ë ë 
: 


01 O3 Mean : 0.008594 
3rd Qu. :2014-06-30 17 3rd Qu.: 0.012562 
Max 2015-04-26 21 Max. : 0.051020 


NA'S :19 


构建 下 限 : 


> Lower «- BollingerBands$dn - HighLowClosexts$Close 


4 


输出 Lower 数 据 框 的 概要 。summary() AAE T Ze FHiSOBB FIERA, ed EB XUJERSOSURAETRABUSUE EE. Lower 
效 据 框 作 为 Summary () 函数 的 输入 参数 : 


> summary (Lower) 


结果 如 下 : 


Index dán 
Min. :2012-01-02 06: Min. :-0.042220 
ist Qu. «2012-11-02 05: 15τ Qu.:-0.012141 
Median :2013-09-03 01: Median :-0.006606 


TREE: 
S85828 


Mean :2013-09-01 03: Mean :-0.008372 
3rd Qu. :2014-06-30 17: 3rd Qu. :-0. 002868 
Max. :2015-04-26 21: Max. : 0.008861 

NA'S :19 
构建 中 间 值 : 


> Middle <- BollingerBands$mavg - HighLowClosexts$Close 


输出 Middle 数 据 框 的 概要 。summary() AAE 26 FISORSFHERAL, ERRAN RAAE KIRE. Middle 
数据 框 作为 Summary () 函数 的 输入 参数 : 


> summary (Middle) 


结果 如 下 : 
Index mavg 

Min. :2012-01-02 06:00:00 Min. :-0.02622?2 
1st Qu.:2012-11-0? 05:00:00 1st Qu. :-0. 004377 
Median :2013-09-03 01:00:00 Median :-0.000038 
Mean :2013-09-01 03:57:22 Mean 0.000111 
3rd Qu. :2014-06-30 17:00:00 3rd Qu 0. 004425 
Max. :2015-04-26 21:00:00 Max. . 0.025714 


NA ` 5 :19 


使 用 Delt () RAZOR ERIAN — SRBBJSEMG ENG EO, k- TXEZRSETGUESRERBSIEJRBEA, fhfRCPRECESUISTE 
PercentageChngpctBrh: 


> PercentageChngpctB <- Delt (BollingerBands$pctB,k-1) 


使 用 提供 项 目 分 析 的 函数 describe () 摘 述 数据 集 ，PercentageChngpctB 作 为 国 数 的 输入 参数 : 


> describe (PercentageChngpctB) 


结果 如 下 : 


PercentagecChngpctB 


1 variables 5257 Observations 


Delt.1.arithmetic 


n missing unique Info Mean -05 -10 <25 .50 -75 .90 .95 
5237 20 5237 1 -2.016 -1.07295 -0.54484 -0.14324 -0.01858 0.16710 0.57484 1.13343 
lowest : -8426.29 -2130.42 -83.18 -75.28 -74.12, highest: 36.73 37.56 57.70 58.12 74.48 


计算 数据 框 Upper 的 变化 百分比 ，k= 1 表示 变化 跨越 的 周期 数 : 


> PercentageChngUp <- Delt (Upper,k-1) 


使 用 提供 项 目 分 析 的 函数 describe () 摘 述 数据 集 ，PercentageChngUp 作 为 国 数 的 输入 参数 : 


> describe (PercentageChngUp) 


结果 如 下 : 


Percentagechngup 


1 variables 5257 Observations 


Delt.1.arithmetic 


n missing unique info Mean .05 .10 .25 .50 -75 - 90 .95 
5237 20 5237 1 0.03257 -1.37131 -0.69452 -0.23013 -0.02814 0.19289 0.74148 1.50053 
lowest : -1363.07  -861.89 -98.12 -48.49 -38.79, highest: 46.20 52.45 66.20 107.11 2230.24 


计算 数据 框 Lower 的 变化 百分比 ，k=1 表 示 变化 跨越 的 周期 数 


> PercentageChngLow «- Delt (Lower, k=1) 


使 用 提供 项 目 分 析 的 函数 describe () 描述 数据 集 ，PercentageChngLow 作 为 六 数 的 输入 参数 : 


= 


> describe (PercentageChngLow) 


结果 如 下 : 
Percent agechngL ow 
1 variables 5257 Observations 
Delt.1.arithmetic 
n missing unique Info Mean .05 .10 25 - 50 4225 .90 .95 
5237 20 5237 1 0.3371 -1.47272 -0.74089 -0.23429 -0.02817 0.17183 0.70740 1.43229 


lowest : -278.00 -268.28 -217.24 -82.49 -71.47, highest: 105.26 251.08 507.36 4868.97 1003.04 


计算 数据 框 Middle 的 变化 百分比 ，k=1 表 示 变 化 跨越 的 周期 数 : 
> PercentageChngMid <- Delt (Middle, k=1) 


使 用 提供 项 目 分 析 的 函数 describe () 摘 述 数据 集 ，PercentageChngMid 为 国 数 的 输入 参数 : 


> describe (PercentageChngMid) 


结果 如 下 : 


PercentagechngMid 
1 variables 5257 Observations 


Delt.1.arithmetic 
n missing unique Info Mean .05 .10 . 25 .50 425 .90 .95 
5237 20 5237 1 -0.3783 -2.20895 -1.06928 -0.35203 -0.08207 0.19687 0.92735 2.15286 


lowest : -959.5 -847.8 -737.4 -366.2 -227.7, highest: 152.7 241.3 312.5 377.0 591.9 


计算 数据 框 HighLowClosexts$Close 的 变化 自分 比 ，k= 1 表示 变化 跨越 的 周期 数 : 


> Returns «- Delt(HighLowClosexts$Close, k-1) 


第 4 步 : 构建 模型 


8/$£8 πολι, BRENifelse () 返回 值 为 测试 表达 式 ， 它 本 身 是 一 个 向 量 ， 并 且 与 测试 表达 式 的 长 度 相同 。 如 果 测 试 表 
达 式 的 相应 值 为 TRUE， 则 返回 的 向 量具 有 来 自 x 的 元 素 ， 如 果 测 试 表达 式 的 相应 值 为 FALSE， 则 具有 来 自 y 的 元 素 。 


这 里 ，Returns> 0 是 测试 函数 ， 它 将 以 逻辑 模式 进行 测试 。 使 用 参数 UP 和 DOWN 执 行 逻辑 测试 ， 然 后 将 结果 仓储 在 数据 框 
binaryClassification 中 : 


> binaryClassification <- ifelse (Returns>0,"Up", "Down") 


探索 价格 变化 的 概要 。 函 数 summary () 国 数 提供 了 一 系列 摘 述 性 统计 信息 ， 以 生成 数据 框 binaryClassification 的 概要 结 
E: 


> summary (binaryClassification) 


结果 如 下 : 
Index Delt.1.arithmetic 

Min. : 2012-01-02 06:00:00 Down:2618 

1st Qu.:2012-11-02 05:00:00 up :2638 

Median :2013-09-03 01:00:00 NA's: 1 

Mean :2013-09-01 03:57:22 

3rd Qu. :2014-06-30 17:00:00 

Max. :2015-04-26 21:00:00 


将 类 后 移 一 位 : 
> ClassShifted <- binaryClassification[-1] 


整合 所 有 特征 。 基 于 紧密 耦合 的 变量 集 ， 使 用 函数 data frame () 创建 数据 框 。 这 些 变量 共享 矩阵 的 属性 。 


作为 参数 传递 给 data.frame () 的 变量 有 Upper、Lower、Middle、BollingerBands$pctB、PercentageChngpctB、 
PercentageChngUp、PercentageChngLow 和 PercentageChngMid。 结 果 存 储 在 数据 框 FeaturesCombined 中 


> FeaturesCombined «- data.frame(Upper, Lower, Middle, 
BollingerBands$pctB, PercentageChngpctB, PercentageChngUp, 
PercentageChngLow, PercentageChngMid) 


IRAETA, BEZEsummary () 国 数 提供 了 一 系列 摘 述 性 统计 信息 ， 以 生成 数据 框 FeaturesCombined 的 概要 结 
T 


> summary (FeaturesCombined) 


结果 如 下 : 
up dn mavg pctB Delt.1.arithmetic X Delt.1.arithmetic.1  Dpelt.1.arithmetic.2 

Min. :-0.012491 Min. :-0.042220 Min. :-0.026222 Min. :-0. 3462 Min. :-8426. 293 Min. :-1363.0732 Min. :-278. 0016 

1st Qu.: 0.002766 1st Qu. :-0. 012141 1st Qu. :-0. 004377 1st Qu.: 0.2120 1st Qu.: -0.143 1st Qu.: -0.2301 1st Qu.: -0.2343 

median : 0.006554 median :-0.006606 median :-0.000038 median : 0.5038 median : -0.019 Median : -0.0281 Median : -0.0282 

Mean : 0.008594 Mean :-0.008372 Mean : 0.000111 Mean : 0.5018 Mean : -2.016 Mean - 0.0326 Mean : 0.3371 

3rd Qu.: 0.012562 3rd Qu. :-0.002868 3rd Qu. : 0.004425 3rd Qu.: 0.7895 3rd Qu.: 0.167 3rd Qu.: 0.1929 3rd Qu. : 0.1718 

Max. : 0.051020 Max. : 0.008861 Max. : 0.025714 Max. : 1.4310 Max. = 74.480 Max. : 2230.2382 Max. :1003. 0420 

NA'S :19 NA'S :19 NA'S :19 NA'S :19 NA'S :20 NA'S :20 NA'S :20 

Delt.1.arithmetic.3 

Min. : -959.4667 

1st Qu.: -0.3520 

median : -0.0821 

Mean : -0.3783 

3rd Qu.: 0.1969 

Max. : 591.9231 


NA'S :20 


匹配 分 类 : 
> FeaturesShifted «- FeaturesCombined[-5257,] 


整合 FeaturesShifted 和 ClassShifted 数 据 框 。 作 为 参数 传递 给 data.frame () 的 变量 为 FeaturesShifted 和 ClassSshifted。 
结果 存储 在 数据 框 FeaturesClassData 中 : 


> FeaturesClassData <- data.frame(FeaturesShifted, ClassShifted) 


FRZS4 TFS S> MEER, BREAsummary () 水 数 提 供 了 一 系列 描述 性 统计 信息 ， 以 生成 数据 框 FeaturesClassData 的 概要 结 
ΞΕ: 


> summary (FeaturesClassData) 


结果 如 下 : 
up dn mavg pctB Delt.1.arithmetic — Delt.1.arithmetic.1  Delt.1.arithmetic.2 

Min. :-0.012491 Min. :-0.042220 Min. :-0.026222 Min. :-0. 3462 Min. :-8426. 293 Min. :-1363.0732 Min. :-278.0016 
1st Qu.: 0.002766 1st Qu.:-0.012137 1st Qu.:-0.004376 1st Qu.: 0.2119 1st Qu.: -0.143 1st Qu.: -0.2301 1st Qu.: -0.2343 
median : 0.006555 Median :-0.006606 median :-0.000037 median : 0.5036 Median : -0.019 median : -0.0282 Median : -0.0282 
Mean : 0.008595 Mean :-0.008369 Mean : 0.000113 Mean : 0.5017 Mean : -2.017 Mean : 0.0324 Mean : 0.3372 
3rd Qu.: 0.012564 3rd Qu. :-0.002868 3rd Qu. : 0.004426 3rd Qu.: 0.7895 3rd Qu. : 0.167 3rd Qu.: 0.1922 3rd Qu.: 0.1718 
Max. : 0.051020 Max. : 0.008861 Max. : 0.025714 Max. : 1.4310 Max. : 74.480 Max. : 2230.2382 Max. :1003. 0420 
NA's :19 NA `S :19 NA'S :19 NA'S :19 NA'S :20 NA'S :20 NA'S :20 
Delt.1.arithmetic.3 Delt.1.arithmetic.4 
Min. :-959.4667 Down:2618 
15τ Qu.:  -0.3520 Up :2638 
Median : -0.0821 
Mean : -0.3784 
3rd Qu. : 0.1969 
Max. : 591.9231 
NA's :20 

COL. 
删除 已 算 指标 : 


> FinalModelData «- FeaturesClassData[-c(1:20),] 
HIREA. Kc () 用 于 将 参数 组 合成 向 量 : 


> colnames(FinalModelData) <- 
σ("ροζΒ'", "LowDiff","UpDiff","MidDiff","PercentageChngpctB", "PercentageChngU 
p","PercentageChngLow","PercentageChngMid", "binaryClassification") 


探索 FinalModelData 数 据 框 的 内 部 结构 。 使 用 函数 str () 探索 作为 R 对 象 的 FinalModel-Data 数 据 框 的 内 部 结构 : 


> str(FinalModelData) 


结果 如 下 : 


"`data.frame `: 5236 obs. of 9 variables: 


$ pctB : num 0.0198 0.0198 0.0191 0.0212 0.0197 ... 

$ LowDiff : num -0.00265 -0.00264 -0.00333 -0.0016 -0.00366 ... 

$ upDiff : num 0.00855 0.00859 0.00787 0.00981 0.00801 ... 

$ midDiff : num 0.096 0.111 0.136 0.103 0.163 ... 

$ PercentagechngpctB : num -0.564 0.159 0.221 -0.243 0.581 ... 

$ Percentagechngup : num 0.02176 0.00271 -0.0378 0.11363 -0.07314 ... 

$ PercentagechngLow - num 0.1391 -0.00506 0.26256 -0.51833 1.2865 ... 

$ PercentagechngMi d : num 0.00572 0.00392 -0.08388 0.24726 -0.18416 ... 

$ binaryclassification: Factor w/ 2 levels "Down","Up: 1212112122... 


> set.seed(1) 


使 用 分 类 (第 9 列 ) 评估 特征 (第 1 ~ 9 列 ) 以 找到 每 棵 树 的 最 优 特征 数 。FinalModel-Data[，-9] 表 示 预 测 变量 的 数据 
框 ，FinalModelData[，9] 表 示 啊 应 变量 的 数据 框 。ntreeTry=100 表 示 在 调整 步骤 中 使 用 的 树 的 数量 。stepFactor= 1.5 表 示 每 
次 迭代 ，mtry 通 货 膨胀 的 速度 ，improve=0.01 意 味 着 oob (out-of-bag) 错误 的 (相对) 改进 必须 大 量 用 于 继续 搜索 。 
trace=TRUE 表 示 是 否 输 出 搜索 的 进度 。dobest=FALSE 表 示 是 否 运 行 通过 使 用 最 佳 mtry 找 到 的 森林 : 


> FeatureNumber <- tuneRF(FinalModelData[,-9], FinalModelData[,9], 
ntreeTry-100, stepFactor-1.5, improve-z0.01, trace-TRUE, plot-TRUE, 
dobest-FALSE) 


使 用 为数 randomForest () 基于 所 有 特征 来 预测 类 ， 每 棵 树 具有 两 个 特征 。data=FinalModelData 表 示 包 合 模 型 中 变量 
的 数据 框 。mtry=2 表 示 在 每 次 分 割 时 随机 抽样 的 变量 数量 。ntree=2000 表 示 要 生长 的 树 的 数量 。keep.forest=TRUE 表 示 和 森林 
将 保留 在 输出 对 象 中 。important=TRUE 表 示 要 评估 的 预测 的 重要 性 : 


> RandomForest «- randomForest (binaryClassification-., 
data-FinalModelData, mtry-2,  ntree-2000, keep.forest-TRUE, 
importance-TRUE) 


结果 如 下 : 


0.5052 


0.5050 
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绘制 随机 和 森林: 
> varlImpPlot (RandomForest, main = 'Random Forest: Measurement of 


Importance of Each Feature',pch-16,col-'blue' ) 


结果 如 下 : 


随机 和 森林 : 衡量 每 个 特征 的 重要 度 


PercentageChngpctB PercentageChngpctB 
PercentageChngLow PercentageChngLow 
LowDiff PercentageChngUp 
PercentageChngUp PercentageChngMid 
UpDiff LowDiff 
PercentageChngMid UpDiff 
pctB pctB 
MidDiff MidDiff 
-8 -6 -4 -2 0 0 50 100 150 200 250 300 350 
平均 准确 度 增 长 平均 Gini 值 增长 


6.7 sess: 货币 交易 案 略 


外 汇市 场 是 一 个 国际 交易 市 场 ， 每 个 国家 的 货币 都 可 以 目 由 出 售 和 买卖 。 供 应 和 需求 共同 驱动 着 一 种 仅 由 市 场 参与 者 决定 的 
货币 的 价格 。 交 易 是 通过 个 人 合约 进行 的 。 标 准 合约 规模 (也 称 为 批量 ) 通常 为 100000 个 单位 。 这 丈 意 味 看 ， 对 于 每 个 所 获得 
的 标准 合约 来 说 ， 控 制 权 是 基准 贷 币 的 10 万 单位 。 对 于 这 个 合约 规模 ， 每 个 点 (pip， 最 小 的 价格 波动 单位 ) 是 10 美 元 。 根 据 交 
易 者 的 交易 策略 ， 头 寸 (position) 可 以 维持 很 短 的 时 间 ， 也 可 以 持续 更 长 时 间 ， 甚 至 几 年 。 可 供 交 易 者 使 用 能 够 了 解 和 做 出 市 
场 决策 的 工具 基本 上 是 基础 性 或 技术 性 分 析 的 。 基 础 分 析 考 虑 到 政治 和 经 济 信 息 的 不 断交 流 。 技 术 分 析 主 要 基于 价格 、 时 间 和 成 
交 量 一 一 货币 达到 的 最 低 和 最 高 价格 、 时 间 段 、 交 易 数量 等 。 拉 术 分 析 也 假定 市 场 的 重复 性 ， 即 在 过 去 友 生 的 事情 会 在 未 来 再 
次 友 生 。 它 分 析 过 去 的 报价 ， 并 根据 统计 和 数学 计算 预测 价格 。 





准备 工作 
我 们 使 用 美元 和 英镑 的 数据 集 来 搭建 支持 向 量 机 。 
第 1 步 : 收集 和 描述 数据 
选用 的 数据 集 PoundDollar.csv 是 标准 格式 数据 集 ， 人 存储 5257 行 数据 和 6 个 变量 ， 其 中 数值 型 变量 包括 : 
- Date 
: Open 


: High 


: Close 


: Volume 


以 下 为 实现 细节 。 


第 2 步 : 探索 数据 


首先 需要 加 载 以 下 软件 包 : 


V V V V 


install.packages ("quantmod") 
install.packages ("e1071") 
install.packages ("Hmisc") 
install.packages ("ggplot2") 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.3.0 (2016-05-03) ο 


需要 安 六 以 上 软件 包 的 相应 库 : 


V V V V 


现在 开始 探索 数据 并 理解 参数 之 间 的 关系 。 我 们 导入 PoundDollar.csv 数 据 集 并 保存 为 PoundDollar 数 据 框 : 


library ("quantmod") 
library("e1071") 
library ("Hmisc") 
install.packages("ggplot2") 


> PoundDollar <- read.csv("d:/PoundDollar.csv") 


输出 PoundDollar 数 据 框 。 使 用 遂 数 head () 3mIBlPoundDollarZiist&RS3- Spam, PoundDollarf'EZJERZNB 8 A. 


> head (PoundDollar) 


结果 如 下 : 


Date 
1/2/12 6:00 
1/2/12 10:00 
1/2/12 14:00 
1/2/12 18:00 
1/2/12 22:00 
1/3/12 2:00 


CQ un h uN F 
Q ωι h ω τω F x 


探索 PoundDollar 数 据 框 的 内 部 结构 。 使 用 函数 str() 探索 作为 R 对 象 的 PoundDollar 数 据 框 的 内 部 结构 : 


Open 
1.55051 
1.55170 
1.54797 
1.55036 
1.55095 
1.55272 


» str(PoundDollar) 


结果 如 下 : 


HMHHBHHHH 


High 


. 55411 
.55230 
. 55147 
. 55155 
- 55342 
.- 55547 


1.54845 
1.54746 
1.54668 
1.54810 
1.54967 
1.55200 


Close volume 


. 55170 
.54797 
. 55036 
. 55095 
.55272 
. 55457 


4803 
2263 
2375 
1767 
4271 
4383 


Py 


= 


Ἐπ: 


'data.frame': 5257 obs. of 7 variables: 

$ x : int 12345678910... 

$ Date : Factor w/ 5257 levels E- dg a 10:00",..: 171 167 168 169 170 369 371 366 367 368 ... 
$ open - num 1.55 1.55 1.55 1.55 1.55 - 

$ High : num 1.55 1.55 1.55 1.55 1.55 ... 

$ Low : num 1.55 1.55 1.55 1.55 1.55 ... 

$ close : num 1.55 1.55 1.55 1.55 1.55 

$ volume: int 4803 2263 2375 1767 4271 4383 15191 22655 23244 10215 ... 


第 3 步 : 计算 指标 


使 用 水 数 RSI () 计算 相对 强 弱 指标 (Relative Strength Index, RSI) 。RSl 是 近期 上 涨 价格 走势 与 绝对 价格 走势 的 比率 。 
数据 框 PoundDollar 代 表 价 格 系列 ，n=3 表 示 移 动 平均 线 的 周期 数 ， 结 果 存 储 在 数据 框 relativeStrengthindex3 中 : 


> relativeStrengthIndex3 «- RSI(Op(PoundDollar), n= 3) 


探索 价格 变化 的 概要 。 遂 数 summary() 水 数 提 供 了 一 系列 描述 性 统计 信息 ， 以 生成 数据 框 relativeStrengthindex3 的 概 
要 结果 : 


> summary (relativeStrengthIndex3) 


结果 如 下 : 
Min. 1st Qu. Median Mean 3rd Qu. Max. NA 5 
0.2408 29.2700 51.6300 50.5800 72.0000 99.7900 3 


计算 PoundDollar 系 列 的 移动 平均 线 。SMA 计 算 过 去 一 组 观测 值 的 序列 的 算术 平均 值 。n= 50 表 示 平 均 周 期 数 : 


> SeriesMeanAvg50 <- SMA(Op(PoundDollar), n-50) 


输出 SeriesMeanAvg50 数 据 框 的 概要 。summary () HÄ E CZARA, JEE XJ BEASAGESTETRHABUAAGERSTRL 
要 。SeriesMeanAvg50 数 据 框 为 summary () 函数 的 输入 参数 : 


> summary (SeriesMeanAvg50O) 


结果 如 下 : 
Min. 1st Qu. Median Mean 3rd Qu. Max. NA 5 
1.477 1.551 1.590 1.591 1.626 1.714 49 


使 用 提供 项 目 分 析 的 国 数 describe () 来 描述 数据 集 ，SeriesMeanAvg50 为 六 数 的 输入 参数 : 


> describe (SeriesMeanAvg50) 


结果 如 下 : 
seriesMeanAvg50 
n missing unique Info Mean . 05 .10 425 .50 425 . 90 .95 
5208 49 5204 1 1.591 1.505 1.516 1.551 1.590 1.626 1.676 1.688 


lowest : 1.477 1.477 1.477 1.477 1.477, highest: 1.714 1.714 1.714 1.714 1.714 


测量 趋势 。 找 出 开盘 价 与 50 周 期 简单 移动 均线 之 间 的 帮 别 |: 


> Trend <- Op(PoundDollar) - SeriesMeanAvgb5O 


输出 数据 框 Trend 的 概要 。 数 据 框 Trend 为 函数 summary () 的 输入 参数 : 


> summary (Trend) 


结果 如 下 : 
Min. 1st Qu. Median Mean 3rd Qu. Max. NA `S 
-0.03636 -0.00725 0.00031 -0.00021 0.00745 0.03877 49 


计算 开盘 价 和 收盘 价 之 间 的 价格 考 别 ， 结 果 存 储 在 数据 框 PriceDiff 中 : 


> PriceDiff <- Cl(PoundDollar) - Op(PoundDollar) 


输出 数据 框 PriceDiff 的 概要 。 数 据 框 PriceDiff 为 函数 summary () 的 输入 参数 : 


> summary (PriceDiff) 


结果 如 下 : 


Min. lst Qu. Median Mean 3rd Qu. Max. 
-1.844e-02 -1.220e-03 2.000e-05 -6.253e-O06 1.200e-03 2.699e-02 


第 4 步 : 准备 变量 构建 数据 集 


创建 二 元 分 类 变量 。 阅 数 ifelse () 返回 值 为 测试 表达 式 ， 它 本 身 是 一 个 向 量 ， 并 且 与 测试 表达 式 的 长 度 相同 。 如 果 测 试 表 
达 式 的 相应 值 为 TRUE， 则 返回 的 向 量具 有 来 自 x 的 元 素 ， 如 果 测 试 表达 式 的 相应 值 为 FALSE， 则 具有 来 自 y 的 元 素 。 


这 里 ，PriceChange>0 是 测试 函数 ， 它 将 以 逻辑 模式 进行 测试 。 使 用 参数 UP 和 DOWN 执 行 逻 辑 测试 ， 然 后 将 结果 存储 在 
数据 框 binaryClassification 中 : 


> binaryClassification <- ifelse(PriceDiff»0,"UP","DOWN") 

输出 数据 框 binaryClassification 的 概要 。 数 据 框 binaryClassification 为 函数 summary () 的 输入 参数 : 
> summary (binaryClassification) 

结果 如 下 : 


Length Class Mode 
5257 character character 


整合 相关 数据 框 Strengthlndex3、Trend 和 binaryClassification。 作 为 参数 传递 给 data.frame () 的 变量 为 
Strengthlndex3、Trend 和 binaryClassification。 结 果 存 储 在 数据 框 DataSset 中 : 


> DataSet «- data.frame(relativeStrengthIndex3, Trend, 
binaryClassification) 


输出 数据 框 DataSet 的 概要 。 数 据 框 DataSet 为 函数 summary () 的 输入 参数 : 


> summary (DataSet) 


结果 如 下 : 
relativestrengthindex3 Trend binaryclassification 
Min. : 0.6199 Min. :-0. 03636 DOWN : 2618 
lst Qu. :28. 8542 lst Qu. :-0. 00725 UP :2639 
median :50. 6667 Median : 0.00031 
Mean :50. 3598 Mean :-0. 00021 
3rd Qu. :72.0845 3rd Qu.: 0.00745 
Max. :99. 5032 Max. : 0.03877 
NA ' S -3 NA 5 :49 


探索 DataSet 数 据 框 的 内 部 结构 : 使 用 函数 str () 探索 作为 R 对 象 的 DataSet 数 据 框 的 内 部 结构 : 


> str(DataSet) 


结果 如 下 : 


"'data.frame': 5257 obs. of 3 variables: 

$ relativestrengthirndex3: num ΝΑ ΝΑ NA 49 54.5 ... 

$ Trend - num ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ NA ... 

$ binaryclassification : Factor w/ 2 levels "DOWN”,"”UP”: 2 1 2 2 2 2 2 2 2 1 ... 


计算 指标 ， 创 建 数据 集 ， 删 除 点 : 


> DataSet «- DataSet[-c(1:49),] 


探索 Dataset 数 据 框 的 维度 。 使 用 dim () BEDAEI[BIDataSetZimtERSAEIE, DataSet FARAS. RARE 
地 显示 数据 框 有 5208 行 数据 和 3 列 : 


> dim(DataSet) 
结果 如 下 : 
[1] 5208 3 


分 离 训练 数据 集 : 


> TrainingDataSet «- DataSet[1:4528,] 


探索 TrainingDataSet 数 据 框 的 维度 。 使 用 dim () 函数 返回 TrainingDataSet 数 据 框 的 维度 ，TrainingDataSet 作 为 函数 的 
输入 参数 。 返 回 结果 清楚 地 显示 数据 框 有 4582 行 数据 和 3 列 : 


> dim(TrainingDataSet) 
结果 如 下 : 
[1] 4528 3 


输出 数据 框 TrainingDatasSet 的 概要 。 数 据 框 TrainingDatasSet 为 函数 summary () 的 输入 参数 : 


> summary (TrainingDataSet) 


结果 如 下 : 


relativestrengrhIndex3 


Min. : 0.6199 
lst Qu. :29.1705 
Median :50.8829 
Mean : 50. 7597 
3rd Qu. :72. 5465 
Max. :99. 5032 


分 离 测试 数据 集 : 


Min. 


Trend 
--0. 0363598 


lst Qu. :-0. 0071439 


median 
Mean 


3rd Qu.: 


Max. 


: 0.0006596 
: 0.0001243 


0. 0077117 


: 0. 0387742 


> TestDataSet <- DataSet[4529:6038,] 


binaryclassification 
DOWN : 2247 
UP :2281 


探索 TestDataSet 数 据 框 的 维度 。 使 用 dim () AŽ0RE]TestDataSetžģ EAE, TestDataSet(E7ZJERZAB JAN AES. K 
回 结果 清楚 地 显示 数据 框 有 有 1510 行 数据 和 3 列 : 


> dim(TestDataSet) 


结果 如 下 : 


[1] 1510 s 


输出 数据 框 TestDataSet 的 概要 。 数 据 框 TestDataSet 为 函数 summary () 的 输入 参数 : 


> summary (TestDataSet) 


结果 如 下 : 


relativestrengthIindex3 


Min. : 0.966 
15τ Qu.:26.358 
Median :49.089 
Mean :48. 071 
3rd Qu. :69. 500 
Max. :96. 014 
NA `S :830 


第 5 步 : 构建 模型 


Trend 

Min. :-0. 0363 
1st Qu. :-0. 0082 
Median :-0.0014 
Mean :-0. 0025 
3rd Qu.: 0.0059 
Max. : 0.0240 
NA 5 :830 


binaryclassification 


DOWN : 347 
UP :333 
NA ς:830 


使 用 函数 svm () 构建 支持 向 量 机 。binaryClassification~relativeStrengthlindex3+Trend 作 为 公 
式 ，data=TrainingDataSet 用 作 包 含 模型 变量 的 数据 框 ，kernel= "radial" 表 示 使 用 径 向 基 核 函数 进行 训练 和 预测 。cost= 1 表示 
约束 违规 的 成 本 。gamma= 1/2 表 示 除 线性 之 外 的 所 有 内 核 国 数 所 需 的 参数 : 


> SVM <- svm(binaryClassification-relativeStrengthIndex3-tTrend, 
data-TrainingDataSet, kernel-"radial", 


cost-1, gamma-1/2) 


输出 数据 框 SVM 的 概要 。 数 据 框 SVM 为 函数 summary () 的 输入 参数 : 


> summary (SVM) 


结果 如 下 : 


Call: 


svm(formula = binaryclassification ~ relativestrengthindex3 + Trend, data = TrainingDataSet, kernel = "radial", 
cost = 1, gamma = 1/2) 


Parameters: 
SvM-Type: Cc-classification 
SvM-Kernel: radial 
cost: 1 
gamma: 0.5 


Number of support vectors: 4401 


( 2202 2199 ) 


Number of Classes: 2 


Levels: 
DOWN UP 





使 用 函数 predict () 基于 模型 对 象 预测 价值 ，SVM 为 输入 对 象 ， 数 据 对 象 TrainingDatasSet 作 为 


变量 的 输入 参数 : 


个 在 其 中 查找 要 预测 的 


> TrainingPredictions «- predict(SVM, TrainingDataSet, type="class") 


输出 数据 框 TrainingPredictions 的 概要 。 数 据 框 TrainingPredictions 为 国 数 summary () 的 输入 参数 : 


= 


> summary(TrainingPredictions) 


结果 如 下 : 


DOWN UP 
2205 2323 


使 用 提供 项 目 分 析 的 函数 describe () 摘 述 数据 集 ，TrainingPredictions 为 函数 的 输入 参数 : 


= 


> describe (TrainingPredictions) 


结果 如 下 : 


TrainirngPredictions 
n missing unique 
4528 


DOWN (2205, 490970), UP (2323, 51376) 


整合 数据 框 TrainingDatasSet 和 TrainingPredictions。 作 为 参数 传递 给 data.frame () 的 变量 为 TrainingDataSet 和 
TrainingPredictions。 结 果 人 存储 在 数据 框 TrainingData 中 : 


> TrainingData <- data. frame (TrainingDataSet, TrainingPredictions) 


输出 数据 框 TrainingData 的 概要 。 数 据 框 TrainingData 为 函数 summary () 的 输入 参数 : 


> summary (TrainingData) 


结果 如 下 : 


relativestrengthindex3 Trend binaryclassification TrainingPredictions 
Min. : 0.6199 Min. :-0.0363598 | DOWN:2247 DOWN : 2205 

1st Qu.:29.1705 15τ Qu.:-0.0071439 UP :2281 UP :2323 

Median :50.8829 Median : 0.0006596 

Mean :50.7597 Mean : 0.0001243 

3rd Qu. :72. 5465 3rd Qu.: 0.0077117 

Max. :99. 5032 Max. : 0.0387742 

输出 TrainingData : 


> ggplot (TrainingData,aes (x-Trend,y-relativeStrengthIndex3)) 
tstat density2d(geom-"contour",aes(color-TrainingPredictions)) 
-tlabs(,x-"Open - SMA50",y-z"RSI3",color-"Training Predictions") 











结果 如 下 : 
SVM Relative Strength Index & Trend Predictions 
ES κι = EGRE 
. IE Ζ | SEE — ü 
DESDE | 
| | | E i 
/ Sb NOE " πουν. 
\ | 2 = 
6.8 BEBUPBEE PIE: 成 人 收入 
随机 梯度 下 降 也 称 为 渐进 梯度 下 降 ， 是 用 于 最 小 化 可 微 浮 数 之 和 的 目标 浮 数 的 梯度 下 降 优化 方法 的 随机 近似 。 它 尝试 通过 


代 找 到 最 小 值 或 最 大 值 。 在 随机 梯度 下 降 中 ， 用 以 下 简单 的 梯度 近似 Q (w) 的 真实 梯度 : 
w: —w-aQ; (w) 


， 每 个 训练 示例 按 以 上 公式 进行 更 新 梯度 。 可 以 在 训练 集 上 生成 一 些 通 道 ， 直 到 算 


J 了 混 洗 以 防止 循环 。 上 典型 的 实现 可 以 使 用 目 适 应 学 习 速 这 ,使 得 算法 收 从。 


算法 扫描 训练 集 
道 数据 进 


随 着 
做 ， 可 以 对 每 个 通 


准备 工作 


我 们 使 用 人 口 普查 的 数据 集 来 搭建 随机 梯度 下 降 并 预测 收入 。 


i£ 


SS, ARAE 


第 1 步 : 收集 和 摘 述 数据 
选用 的 数据 集 adult.txt 是 标准 格式 数据 集 ， 人 存储 32561 行 数据 和 15 个 变量 ， 其 中 数值 型 变量 包括 : 
` age 

: fnlwet 

: education-num 

: capital-gain 

- capital-loss 

: hours-pet-week 
非 数 值 型 变量 包括 : 

` wotkclass 

- education 

: matital-status 

* Occupation 

: relationship 

° face 

' Sex 

: native-countty 


. incometange 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 
首先 需要 加 载 以 下 软件 包 : 


> library("klar") 
> library("caret") 
> library ("stringr") 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.3.0 (2016-05-03) 。 


现在 开始 探索 数据 并 理解 参数 之 间 的 关系。 我 们 导入 adult.txt 数 据 集 并 保存 为 allData 数 据 框 : 


> all Data «- read.csv("d:/adult.txt") 


RzxallDatazAdStERSPJEBASTA. fhFBBSEXStr () 探索 作为 R 对 象 的 allData 数 据 框 的 内 部 结构 : 


> str(allData) 


结果 如 下 : 

'data. frame 32561 obs. of 15 variables: 

$ v1 : Factor w/ 73 levels "17,","18,","19," 2. .: 23 34 22 37 12 21 33 36 15 26 ... 
$ v2 : Factor w/ 9 levels "7?,","Federal-gov,",..: 87 55555755 ... 

$ v3 : Factor WA 21648 levels "100009,","100029,",..: 20430 20692 10269 11554 16171 14136 4680 9797 18599 4604 ... 
$ v4 : Factor w/ 16 levels "10th,","1ith,"^,..: 10 10 12 2 10 13 7 12 13 10 ... 

$ v5 : Factor w/ 16 levels "1,","10,"7,"11,"7,..: 5 5 16 14 5612 16 6 5 I 

$ v6 : Factor w/ 7 levels "Divorced,","Married-AF-spouse,",. 4253133434353 
$ v7 : Factor w/ 15 levels "?," , Adm-clerical," iat 2 57 711 5 9 5115... 

4 v8 : Factor w/ 6 levels "Husband, " , "Not-- in- family," ως. 212 166212 ΣΠ 

$ v9 : Factor w/ 5 levels "Amer-Indian- Eskimo," see 5553353555 

$ v10: Factor w/ 2 levels "Female,","Male,": 2 2 2 2 11 1 2 1 2 ... 

$ vil: Factor w/ 119 levels "0,"”,"”10520,"”,..: 34 1 1 1 1 1 1 1 13 95 ... 

$ v12: Factor w/ 92 levels ο,” “1092 ο 1313438. ,..: 11 11 1 1 1 1 1 1 

$ ν13: Factor w/ 94 levels "”1,"”,"”10,”,7”11,”,..: 35 5 35 35 35 35 8 40 46 35 — 

$ V14: Factor w/ 42 levels "2." "Cambodia,",..: 40 40 40 40 6 40 24 40 40 40 ... 

$ V15: Factor WA 2 levels "«—-50K","-50K^: 1111111222... 


第 3 步 : 准备 数据 


容 性 。 结 果 仓储 在 





从 主要 文件 中 获取 标签 。 使 用 函数 as.factor () 将 向 量 allData[，15] 编 码 为 
数据 框 labels 中 : 





> labels «- as.factor(allData[,15]) 


获取 移 除 标签 后 的 所 有 特征 ， 结 果 存 储 于 数据 框 allFeatures 中 : 


> allFeatures «- allData[,-c(15)] 


输出 数据 框 allFeatures。 使 用 函数 head () 返回 数据 框 allFeatures 的 头 部 数据 ，allFeatures 作 为 函数 的 输入 参数 : 


> head(allFeatures) 


结果 如 下 : 

v1 v2 v3 να v5 v6 v7 v8 v9 v10 
1 39, State-gov, 77516, Bachelors, 13, Never-married, Adm-clerical, Not-in-family, white, Male, 
2 50, Self-emp-not-inc, 83311, Bachelors, 13, Married-civ-spouse, Exec-manager ial, Husband, white, Male, 
3 38, Private, 215646, — HS-grad, 9, Divorced, Handlers-cleaners, Not-in-family, white, male, 
4 53, Private, 234721, lith, 7, Married-civ-spouse, Handlers-cleaners, Husband, Black, Male, 
5 28, Private, 338409, Bachelors, 13, Married-civ-spouse, Prof-specialty, wife, Black, Female, 
6 37, Private, 284582, Masters, 14, Married-civ-spouse, Exec-managerial, wife, white, Female, 

v11 2 νι3 v14 


v1 

0, 40, united-states, 
0, ο, 13, united-Sstates, 

0, 40, united-states, 

0, 40, united-states, 

0, 40, cuba, 

0, 40, united-states, 


σι un & W NH 


SMEH—4. BAABA RAZE, fiíSvariance-1, ERZÁscale () AAND AERAN. 
continuousFeatureszeZW-z Br, £5tRITh&CEEXSEcontinuousFeaturesrn: 


» continuousFeatures «- scale(continuousFeatures) 


输出 数据 框 continuousFeatures。 使 用 了 消 数 head () 返回 数据 框 continuousFeatures 的 头 部 数据 ，continuousFeatures 


作为 函数 的 输入 参数 : 


> head(continuousFeatures) 


结果 如 下 : 


V1 V3 v5 V11 V12 V13 
[1,] 0.03067009 -1.0635944 1.1347213 00.1484506 -0.2166562 -0.0354289 
[2,] 0.83709613 -1.0086915 1.1347213 -0.1459182 -0.2166562 -2.2221190 
[3,] -0.04264137 Ο.2450747 -0.4200532 -0.1459182 -0.2166562 -0.0354289 
[4,] 1.05703050 0.4257948 -1.1974404 -0.1459182 -0.2166562 -0.0354289 
[5,] -0.77575595 1.4081541 1.1347213 -0.1459182 -0.2166562 -0.0354289 
[6,] -0.11595283 0.8981871 1.5234150 -0.1459182 -0.2166562 -0.0354289 


将 标签 转 换 为 1 或 -1。 使 用 函数 rep () 复制 什 ， 结 果 仔 储 在 数据 框 labels.n 中 : 


labels.n = rep(0,length(labels)) 
labels.n[labels--" «-50K"] = -1 
labels.n[labels--" »50K"] = 1 


labels = labels.n 
rm(labels.n) 


V V M V V 


分 离 训练 数据 集 。 使 用 函数 createDataPartition () 创建 训练 数据 划分 的 集合 。y=labels 代 表 结 果 向 量 ，p=0.8 表 示 80% 的 
数据 用 于 训练 数据 集 : 


> trainingData «- createDataPartition(y-labels, p=.8, list-FALSE) 


探索 数据 框 trainingData 的 维度 。 使 用 dim () ΒΕΠ ΚΙΗ dETEtrainingDataBg €, trainingDataf/E7JESZKBESs8 A S2. 
返回 结果 清楚 地 显示 数据 框 有 26049 行 数据 和 1 列 : 


> dim(trainingData) 


结果 如 下 : 
[1] 26049 1 


创建 数据 框 trainingData 的 训练 特征 和 训练 标签 : 


> trainingFeatures <- continuousFeatures [trainingData,] 
> trainingLabels <- labels[trainingData] 


使 用 剩余 20% 的 数据 进行 测试 和 验证 : 


> remainingLabels «- labels[-trainingData] 
> remainingFeatures <- continuousFeatures[-trainingData,] 


创建 测试 特征 和 测试 标签。 在 这 20% 的 数据 中 ， 一 半 用 于 测试 ， 另 一 半 用 于 验证 。 


使 用 函数 createDatapPartition () 创建 训练 数据 划分 的 集合 。y=remainingLabels 表 示 结 果 向 量 ，p=0.5 表 示 50% 的 数据 用 
于 训练 数据 集 ， 结 果 和 存储 在 数据 框 testingData 中 : 


> testingData <- createDataPartition(y-remainingLabels, p-.5, 
list-FALSE) 

» testingLabels «- remainingLabels[testingData] 

» testingFeatures «- remainingFeatures[testingData,] 


创建 数据 框 testingData 的 验证 特征 和 验证 标签 : 


> validationLabels <- remainingLabels[-testingData] 
> validationFeatures «- remainingFeatures[-testingData,] 


定义 所 需 的 精度 测量 : 


> getAccuracy «- function(a,b,features,labels)( 

十 estFxn = features $*$ a + b; 

十 predictedLabels = rep(0,length(labels)); 

十 predictedLabels [estFxn < 0] = -1 ; 

十 predictedLabels [estFxn >= 0] = 1 ; 

T return(sum(predictedLabels -- labels) / length(labels)) 
Ἔ 


第 4 步 : 构建 模型 


设置 初始 化 参数 : 

> numEpochs = 100 

> numStepsPerEpoch = 500 
> nStepsPerPlot = 30 

> evalidationSetSize = 50 
> c1 = 0.01 

> c2 = 50 


整合 参数 集 ， 结 果 存储 在 数据 框 lambda_vals 中 : 


> lambda vals = c(0.001, 0.01, 0.1, 1) 
> bestAccuracy = 0 


探索 数据 框 lambda_vals 的 内 部 结构 。 使 用 函数 str () 探索 作为 R 对 象 的 数据 框 lambda_vals 的 内 部 结构 : 


> str(lambda vals) 
结果 如 下 : 
num [1:4] 0.001 0.01 0.1 1 


使 用 函数 matrix () 从 一 组 给 定 的 值 创 建 每 个 时 期 的 矩阵 。 
nrow= (numStepsPerEpoch/nStepsPerPlot) *numEpochs+1 代 表 和 矩阵 的 国 数 ，ncol=length (lambda vals) 代表 算 阵 的 
aZ : 


> accMat <- matrix(NA, nrow = 
(numStepsPerEpoch/nStepsPerPlot)*numEpochs-*1, ncol = length(lambda vals)) 


使 用 函数 matrix () JÀ—2B£SxEBMB ERSTES GUI ABE, 
nrow- (numStepsPerEpoch/nStepsPerPlot) *numEpochs-« 14V ZBPERJERSZX, ncolzlength (lambda vals) 代表 算 阵 的 


2: 


> accMatv «- matrix(NA, nrow = 
(numStepsPerEpoch/nStepsPerPlot)*numEpochs41, ncol = length(lambda vals)) 


for(i in 1:4)( 
lambda = lambda vals [i] 
accMatRow - 1 
accMatCol = i 
a = rep(0,ncol(continuousFeatures)) 
b = 0 
stepIndex = 0 
for (e in l:numEpochs) { 


练 数据 划分 的 集合 。y=trainingLabels 代 表 结 果 向 量 ，p= (1- 
练 数据 集 ， 结 果 存 储 在 数据 框 etrainingData 中 : 





使 用 函数 createDataPartition () 创建 训 
evalidationSetSize/length (trainingLabels) ) 比例 的 数据 用 于 训 





etrainingData «- createDataPartition(y-trainingLabels, p-(1 - 

evalidationSetSize/length(trainingLabels)), list-FALSE) 
etrainingFeatures «- trainingFeatures[etrainingData,] 
etrainingLabels «- trainingLabels[etrainingData] 
evalidationFeatures «- trainingFeatures[-etrainingData,] 
evalidationLabels «- trainingLabels[-etrainingData] 
steplength = 1 / (εκει + c2) 


for (step in 1:numStepsPerEpoch)(í 
stepIndex = stepIndex-*1 
index - sample.int(nrow(etrainingFeatures),1) 
xk = etrainingFeatures[index,] 
yk - etrainingLabels[index] 
costfxn = yk * (a $*$ xk + b) 
if (costfxn >= 1)( 


a dir - lambda * a 
a = a — steplength * a dir 


) else ( 


a dir - (lambda * a) - (yk * xk) 
a = a — steplength * a dir 


b = b - (steplength * b dir) 


WFBEgZXgetAccuracy () 记录 精度 : 


if (stepIndex $$ nStepsPerPlot == 1) {430)4{ 
accMat[accMatRow,accMatCol] = 

getAccuracy (a,b,evalidationFeatures,evalidationLabels) 
accMatv[accMatRow,accMatCol] - 

getAccuracy (a,b,validationFeatures,validationLabels) 
accMatRow = accMatRow + 1 


) 

} 

} 

tempAccuracy = getAccuracy(a,b,validationFeatures,validationLabels) 
print(str c("tempAcc - ", tempAccuracy," and bestAcc - ", bestAccuracy) 


if(tempAccuracy > bestAccuracy)( 
bestAccuracy - tempAccuracy 
best a = a 


best b - b 

best lambdaIndex - i 
) 
) 


使 用 前 面 定 义 的 getAccuracy () 计算 模型 的 精度 : 


> getAccuracy (best a,best b, testingFeatures, testingLabels) 


第 5 步 : 绘制 模型 


在 训练 中 绘制 模型 的 精度 。 销 数 c () 将 参数 整合 为 向 


z 


> colors = c("red", "blue", "green", "black") 
设置 图 中 使 用 的 同 量 : 
> xaxislabel = "Step" 
> yaxislabels = c("Accuracy on Randomized Epoch Validation 
Set","Accuracy on Validation Set") 
> 


> ylims=c (0,1) 
> stepValues = seq(1,15000,1ength-500) 


调用 函数 list () 连接 数据 框 accMat 和 accMatv， 创 建 通 用 向 量 : 


> mats = list(accMat,accMatv) 


绘制 图 : 


> for(j in 1:length(mats))( 
mat = mats[[j1] 
for(i in 1:4)( 


if(i == 1)( 


国 数 plot () 为 通用 绘制 R 对 象 的 国 数 ， 数 据 框 stepValues 为 国 数 的 输入 人 参数: 


plot(stepValues, mat[1:500,i], type = "l1",xlim-c(0, 15000), 
ylimzylims, 
col-colors[i],xlab-xaxislabel,ylab-yaxislabels[j],main-title) 
} else( 
lines (stepValues, mat[1:500,i1], type = "1",xlim=c(0, 15000), 
ylimzylims, 
colzcolors[i],xlab-xaxislabel,ylab-yaxislabels[j],main-title) 
) 
Sys.sleep(1) 
) 


legend (x-210000,y2.5,1egend-c("lambda-.001","1lambda-.01","lambda-.1","lambda 
z1"),fill-zcolors) 


) 
图 像 结 果 如 下 : 
精度 与 步 数 及 Lambda 取 值 的 关系 
Oo 
| = 
T ru qn. d P wi | 
ος v FI BN | | tà » get E V, πήξη! 
| | ο) ΤΗΝ μή | 


Vr hu 


0.6 


随机 迭代 轮 数 验证 的 精度 
0.4 





L] lambda-.001 
E lambda-.01 
3 ΕΙ lambda-.1 
E lambda=1 
— 
e 
0 5000 m 10000 15000 


本 章 将 涵盖 如 下 内 容 : 
- 自 组织 映 射 : 可 视 化 热 图 


. kE: 图 像 聚 类 


自 组 织 映 映 (self-organizing map, SOM) : 自 组 织 映 射 是 一 种 基于 竞争 学 习 的 无 监督 学 习 方 法 。 在 基于 竞争 学 习 的 模型 
中 ， 输 出 神经 元 为 了 被 激活 而 竞争 ， 而 在 任何 一 个 时 间 只 有 一 个 神经 元 可 以 被 激活 ， 这 个 激活 的 神经 元 称 为 获胜 和 钊 经 元 。 可 以 通 
过 在 神经 元 之 间 具 有 的 侧 向 抑制 连接 ( 负 反 馈 路 径 ) 来 诱导 /实现 这 种 竞争 ， 使 得 神经 元 组 织 起 来 。SOM 可 以 想象 为 片 状 神经 区 
络 ， 节 操 有 规则 地 排列 ， 通 常 是 二 维 网 格 。SOM 的 主要 目标 是 将 输入 的 任意 维度 信号 转换 为 一 维 或 二 维 离散 映射 ， 并 以 拓扑 有 
序 的 万 式 目 适应 地 执行 该 转换 。 在 竞争 学 习 过 程 中 ， 神 经 元 被 选择 性 地 调整 到 各 种 输入 模式 (刺激) 或 输入 模式 类 别 。 如 此 调整 
的 神经 元 (获胜 神经 元 ) 的 位 置 被 排序 ， 并 且 在 格子 上 创建 用 于 输入 特征 的 有 意义 的 坐标 系 。 因 此 ，SOM 形 成 所 需 的 输入 模式 
的 拓扑 映射 。 


和 天 量 量化 (vector quantization) : 量化 是 通过 标量 或 矢量 的 有 限 集 来 映射 标量 或 矢量 的 无 限 集 的 过 程 。 量 化 在 信号 处 
理 、 语 音 处 理 和 图 像 处 理 领域 均 有 应 用 。 矢 量 量化 对 数据 块 进行 量化 ， 而 不 是 针对 某 一 标量 值 。 量 化 输出 是 从 有 限 的 矢量 集合 
( 称 为 码 书 ，codebook) 指向 另 一 个 数据 块 (KÆ) 的 系 引 值 。 所 选择 的 天 量 通 单 是 输入 数据 块 的 近似 值 。 复 制 天 量 
(reproduction vector) 被 认为 是 编码 器 和 解码 器 。 编 码 器 采用 输入 矢量 ， 其 决定 了 最 佳 表现 复制 矢量 ， 并 友 送 该 矢量 的 索 
引 。 解 码 器 采用 该 索引 并 形成 复制 向 量 。 


7.2 ΕΘΗ: 可 视 化 热 医 


在 过 去 十 年 中 ， 信 息 呈 指数 级 增长 ， 如 果 人 工 从 这 些 信息 数据 库 获取 新 知识 是 比较 困难 、 昂 贵 且 耗 时 的 。 当 数据 规模 和 复杂 
度 超过 一 定 限 度 时 ， 这 些 工作 甚至 可 能 无 法 完成 。 因 此 ， 过 去 几 年 来 ， 大 量 多 维 数 据 集 的 自动 分 析 和 可 视 化 一 直 是 科学 研究 的 重 
点 。 这 种 分 析 和 可 视 化 的 主要 目的 是 在 数据 中 找到 规律 和 关系 ， 进 而 获得 隐藏 和 潜在 有 用 的 知识 。 目 组 织 映 射 (SOM) 是 一 种 
无 监督 伸 经 网 络 算法 ， 将 局 维 数据 投影 至 二 维 地 图 ， 访 投影 保留 数据 的 拓扑 ， 使 得 类 似 的 数据 项 将 映射 到 地 图 上 的 附近 位 置 。 


具体 实施 步骤 
以 下 为 实现 细 市 。 
第 1 步 : 探索 数据 
首先 需要 加 载 以 下 软件 包 : 


> install.packages ("kohonen") 
> library (kohonen) 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.3.2 (2016-10-31) « 
创建 采样 数据 集 : 
> training frame «- data[, 


c(2,4,5,8)] 


AREER. IEFHERZXscale () 集中 和 缩放 和 矩阵 training_frame 的 列 。 使 用 遂 数 as.matrix 从 
scale (training frame) 的 返回 结果 创建 和 矩阵: 


> training matrix <- as.matrix(scale(training frame)) 


输出 training_matrix: 


> training matrix 


结果 如 下 : 

zn chas nox dis 
1 0. 28454827 -0.27/23291 -0.14407485 40.1400749840 
2 -0. 48724019 -0.2723291 -0.73953036 0. 5566090496 
3 -0. 48724019 -0.2723291 -0.73953036 ο. 5566090496 
4 -0. 48724019 -0.2723291 -0.83445805 1.076067/711351 
5 -0.48/24019 -0.27/723291 -0.83445805 1.0766711351 
6 -0. 48724019 -0.27/723291 -0. 83445805 1.0766711351 
7 0.04872402 -0.2723291 -0.26489191 30.8384142195 
8 0.04872402 -0.2723291 -0.26489191 1.02362489/4 
9 0.04872402 -0.2723291 -0.26489191 1.0861216287 
10 0.04872402 -0.2723291 -0.26489191 1.32832020/5 
11 0.04872402 -0.2723291 -0.26489191 1.2117799501 
12 0.04872402 -0.2723291 -0.26489191 1.1547920492 
13 0.04872402 -0.2723291 -0.26489191 20.786306527/700 
14 -0.48724019 -0.2723291 -0.14407485 0.4333252240 
15 -0.48724019 -0.2723291 -0.14407485 4 0.3166899868 
16 -0.48724019 -0.2723291 -0.14407485 0.3341187865 
17 -0.48724019 -0.2723291 -0.14407485 ο 1141158605 
18 -0.48724019 -0.2723291 -0.14407485 30.2198105553 
19 -0.48724019 -0.2723291 -0.14407485 0.0006920764 
Z0 -0.48724019 -0.2723291 -0.14407485 0.0006920764 
21 -0.48724019 -0.2723291 -0.14407485 0.0013569352 
22 -0.48724019 -0.2723291 -0.14407485 30.1031/753182 
23 -0.48724019 -0.2723291 -0.14407485 40.08636388/4 
24 -0.48724019 -0.2723291 -0.14407485 0.1425444597 
25 -0.48724019 -0.2723291 -0.14407485 ο. 2810168 
26 -0.48724019 -0.2723291 -0.14407485 Ο. 1132232221 
27 -0.48724019 -0.2723291 -0.14407485 30.4212152950 
28 -0.48724019 -0.2723291 -0.14407485 0.3126533438 
29 -0.48724019 -0.2723291 -0.14407485 30.31327/707128 
30 -0.48724019 -0.2/23291 -0.14407485 ο 1083496009 
31. -0.48724019 -0.2723291 -0.14407485 0.2079855659 
32 -0.48724019 -0.2723291 -0.14407485 0.1804414138 
attr(, scaled:center") 

zn chas nox dis 


11.36363636 40.06916996 0. 55469506 3. 91041209 
attr(, scaled:scale") 


ΖΠ 


chas 


nox 


dis 


23.3224530 0ο. 2539040 0.1158777 2.105/101 


第 2 步 : 训练 模型 


创建 SOM 网 格 。somgrid () 绘制 了 自 组织 映 射 网 格 的 功能 。xdim=20 和 ydim=20 代 表 网 格 维度 ，topo= "hexagonal" 代 
表 网 格 拓扑 : 


> som grid <- somgrid(xdim = 20, ydim-20, topo-z"hexagonal") 


训练 自 组 织 映 射 。som () 是 自 组 织 映射 中 用 于 将 高 维 范 围 或 学 式 映射 至 二 维 的 函数 。 遂 数 使 用 欧 氏 距 
离 ，training_matrix 为 数据 矩阵 ，rlen=1000 是 将 完整 数据 集 提供 给 网 络 进行 训练 的 次 数 ，alpha 代 表 训 | 练 比 
率 ，keep.data=TRUE 表 示 数 据 存储 在 返回 对 象 中 ，n.hood="circular" 表 示 了 邻居 的 形状 : 


> som model «- som(training matrix, 
t grid-som grid, 

十 rlen-1000, 

t alpha-zc(0.05,0.01), 
+ keep.data = TRUE, 

+ n.hood="circular") 


第 3 步 : 绘制 模型 
绘制 对 象 som_model: 


> plot(som model, main -"Training Progress", type-"changes", col = 
" red" ) 


结果 如 下 : 


训练 过 和 


0.025 





0.020 


0.015 


Mean distance to closest unit 


0.010 


0.005 





0.000 


0 200 400 600 800 1000 


Iteration 


基于 节操 数量 绘制 模型 : 


> plot (som model, main -"Node Count", type="count") 


结果 如 下 : 





基于 邻居 距离 绘制 模型 


> plot(som model, main -"Neighbour Distances", type-"dist.neighbours") 


结果 如 下 : 


Neighhour Distances 





基于 type= "codes" 绘 制 模型 : 


> plot (som model, type-"codes") 


结果 如 下 : 
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基于 property plot 绘 制 模型 : 


> plot(som model, type = "property", property = som model$codes[,4], 
main-names (som model$data)[4]) 


结果 如 下 : 





7.3 ”和 天 量 量化 : 图 像 聚 类 


效 子 媒体 领域 的 技术 发展 产生 大 量 图 像 形式 的 非 文字 信息 。 如 果 程 序 可 以 理解 这 些 图 像 的 意义 ， 那 么 可 能 会 萌生 大 量 不 同 的 
应 用 程序 。 其 中 一 种 应 用 是 机 器 人 从 医院 患者 的 身体 扫 摘 图 像 中 提取 有 悉 性 组 织 来 解释 恶性 组 织 的 位 置 。 图 像 被 认为 是 传达 信息 的 
最 重要 媒介 之 一 。 信 息 检索 的 潜力 是 巨大 的 ， 所 以 用 尸 可 能 被 大 量 的 信息 检索 所 淹没 。 图 像 的 非 结构 化 格式 为 分 类 和 聚 类 技术 市 
来 了 挑战 。 机 器 学 习 算法 可 以 通过 提取 信息 的 方式 了 解 图 像 ， 而 了 解 图 像 的 第 一 步 是 对 图 像 进行 分 割 ， 并 识别 其 中 的 不 同 对 象 。 


为 此 ， 可 以 使 用 直方 图 和 频 域 变 换 等 特征 。 


准备 工作 


第 1 步 : 收集 和 摘 述 数据 


使 用 JPEG 文 件 。 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 
首先 需要 加 载 以 下 软件 包 : 


install.packages ("jpeg") 
install.packages ("ggplot2") 
library (jpeg) 

library (ggplot2) 


V V V V 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.3.2。 

使 用 函数 readJPEG () 读 取 JPEG 格 式 的 图 片 ， 并 转换 为 栅 格 数 组 : 
> img <- readJPEG("d: /Image.jpg") 

第 3 步 : 数据 清洗 


探索 img 的 维度 。 使 用 dim () 函数 返回 数据 框 img 的 维度 ，img 作 为 函数 的 输入 参数 : 


> img Dim «- dim(img) 


输出 img_Dim : 


> img Dim 


结果 如 下 : 


[1] 526 800 3 


下 面 为 数据 框 分 配 RGB 通道 ( 红 、 绿 、 蓝 一 一 RGB 通道 基本 符合 人 眼中 的 颜色 受 体 ) ， 结 果 存 储 在 数据 框 
img RGB channels 中 : 


img RGB channels  «- data.frame( 
x = rep(1:img Dim[2], each = img Dim[1]), 
= rep(img Dim[1]:1, img Dim[2]), 
= as.vector(img[,,1]), 
= as.vector(img[,,2]), 
= as.vector (img[,,3]) 


Πω 2 
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第 4 步 : 可 视 化 已 清洗 数据 
下 面 绘制 原始 图 像 : 


> plotTheme «- function() { 


theme ( 
panel.background - element rect( 
size = 3, 
colour - "black", 
fill - "white"), 
axis.ticks - element line( 


size - 2), 
panel.grid.major = element line( 
colour - "gray80", 
linetype - "dotted"), 
panel.grid.minor = element line( 
colour = "gray90", 
linetype = "dashed"), 
axis.title.x - element text( 
size - rel(1.2), 
face - "bold"), 
axis.title.y - element text( 
size - rel(1.2), 
face - "bold"), 
plot.title - element text( 
size - 20, 
face - "bold", 
vjust - 1.5) 


) 

> ggplot (data = img RGB channels, aes(x = x, y = y)) + 

十 geom point (colour = rgb(img RGB channels[c("R", "G", "B")])) + 
t labs(title = "Original Image: Colorful Bird") + 

t xlab("x") 十 

t ylab("y") + 

十 plotTheme () 


结果 如 下 : 


" 


原始 图 : 
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> kClusters «- 3 
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执行 k 均 值 聚 类 : 使 用 函数 kmeans () 对 数据 矩阵 img_RGB_channels 执 行 聚 类 ，centers=kClusters 表 示 初 始 聚 类 


> kMeans clst «- kmeans (img RGB channels[, c("R", 


kClusters) 


创建 对 应 于 给 定 强 度 的 红色 、 绿 色 和 监 色 三 原色 的 颜色 : 


"G", "B") ] ; 


> kColours «- rgb(kMeans clst$centers[kMeans clst$cluster,]) 


绘制 三 种 聚 类 的 图 像 : 


> ggplot (data = 


十 
十 


十 


十 


img RGB channels, aes(x - x, y = 


geom point (colour = kColours) + 


labs (title 


xlab("x") + 
ylab("y") 十 
plotTheme () 


paste("k-Means Clustering of", 


y)) 十 


kClusters, 


centers = 


"Colours")) 





的 数 


上 均值 聚 类 为 3 种 颜色 





200 400 600 800 


> kClusters <- 5 


执行 k 均 值 聚 类 。 使 用 国 数 kmeans () 对 数据 矩阵 Img_RGB channels 执 行 聚 类 ，centers=kClusters 表 示 初 始 聚 类 的 数 


" 


> kMeans clst «- kmeans(img RGB channels[, c("R", "G", "B")], centers = 
kClusters) 


创建 对 应 于 给 定 强 度 的 红色 、 绿 色 和 监 色 三 原色 的 颜色 : 


> kColours <- rgb (kMeans clst$centers[kMeans clst$cluster,]) 


绘制 三 种 聚 类 的 图 像 : 


> ggplot(data = img RGB channels, aes(x = x, y = y)) + 


十 
+ 


+ 


结果 如 下 : 


geom Point (colour = kColours) + 
labs(title = paste("k-Means Clustering of", kClusters, "Colours")) 


xlab("x") 十 
ylab("y") + 
plotTheme () 


均值 聚 类 为 5 种 颜色 


500 


400 


300 


200 





第 8 草 ”增强 学 习 


本 章 将 肖 兰 如 下 内 容 : 

` 马尔 可 夫 链 : 股票 区 制 转 移 模型 

: 马尔 可 夫 链 : 多 渠道 归 因 模型 
:马尔 可 夫 链 : 汽车 租赁 代理 服务 

. 连续 马尔 可 夫 链 : 加 油 站 的 车 辆 服务 


- 蒙特 卡 罗 模 拟 : 校准 Hull-White 短 期 利率 


8.1 5 引言 


马尔 可 夫 链 : 如 果 每 个 实验 的 结果 是 离散 状态 集合 之 一 ， 且 实验 结果 仪 依赖 于 当前 状态 而 不 依赖 于 过 去 状态 ， 则 称 这 个 实验 
的 一 系列 状态 为 马尔 可 夫 通 ， 从 一 个 状态 变 为 另 个 状态 的 概率 表示 为 Pj， 种 为 转移 梳 率 ， 转 移 枝 率 钼 阵 是 nxn 类 阵 ， 算 阵 
每 个 元 素 是 非 负 的 ， 并 且 算 阵 的 每 一 行 元素 之 和 为 1。 


连续 时 间 马 尔 可 夫 链 : 连续 时 间 马 尔 可 夫 链 可 以 标记 为 具有 离散 状态 的 速率 的 过 渡 系 统 。 状 态 具有 连续 的 时 间 步 骆 ， 延 迟 呈 
指数 分 布 。 连 续 时 间 马 尔 可 夫 链 适用 于 建立 可 靠 性 模型 、 控 制 系统 、 和 后 物 途径 、 化 学 反应 等 。 


ERRAT: 蒙特 卡 罗 模 拟 是 系统 行为 的 随机 模拟 。 模 拟 使 用 对 模型 进行 抽样 实验 ， 然 后 使 用 计算 机 进行 数值 实验 ， 以 获 
得 对 系统 行为 的 统计 学 理解 。 蒙 特 卡 洛 模拟 用 于 构建 被 观察 的 复杂 系统 行为 的 理论 ， 预 测 系 统 的 未 来 行为 ， 以 及 基于 系统 输入 和 
参数 变化 的 最 终结 果 效 果 的 研究 。 随 机 模拟 是 一 种 系统 实验 来 寻找 改进 或 更 好 地 了 解 系统 行为 的 万 法 。 它 使 用 在 区 间 [0，1] 上 均 
义 分 布 的 随机 数 。 这 些 均匀 分布 的 随机 数 用 于 从 各 种 概率 分 布 生 成 随机 变量 ， 然 后 生成 与 系统 行为 的 建 模 相关 的 采样 实 验 。 


82 马尔 可 夫 链 : 股票 区 制 转移 模型 


在 过 去 几 十 年 中 ， 对 流动 率 的 分 析 和 预测 进行 了 大 量 研 究 。 波 动 率 是 按照 回报 标准 差 计算 的 交易 价格 序列 随时 间 变 化 的 程 
度 。 股 票 回报 模型 假设 回报 遵循 几何 布朗 运动 。 这 意味 着 在 任何 离散 的 时 间 间 隔 内 ， 股 票 的 回报 率 是 符合 对 数 正 态 分 布 的 ， 而 在 
非 重 去 间隔 中 的 回报 是 独立 的 。 研 究 友 现 ， 该 模型 未 能 捕获 极端 价格 波动 和 波动 参数 中 的 随机 变异 性 。 随 机 波动 率 取 离 散 值 ， 在 
这 些 值 之 间 随 机 切换 。 这 是 区 制 转移 对 数 正 态 过 程 (regime-switching lognormal process, RSLN) 的 基础 。 


准备 工作 


我 们 使 用 股票 数据 集 来 搭建 马尔 可 夫 链 区 制 转移 模型 。 
第 1 步 : 收集 和 摘 述 数据 

选用 的 数据 集 StocksRegimeSwitching.csv 是 标准 可 访问 数据 集 ， 存 储 66 行 数据 ， 其 中 数值 型 变量 包括 : 
- LRY 

: LRV 

: INT 

: LRC 

ΠΣ 

- LGS 

非 数 值 型 变量 包括 : 


: DATE 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 


首先 需要 加 载 以 下 软件 包 : 


»install.packages ("MSwM") 
»library (MSwM) 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.2.2 (2015-08-14) ο 


现在 开始 探索 数据 并 理解 参数 之 间 的 关系 。 导 入 StocksRegimeSwitching.csv 数 据 集 ， 并 保存 为 数据 框 
MarkovSwitchData : 


> MarkovSwitchData «- read.csv("d:/StocksRegimeSwitching.csv", header = 
TRUE) 


BASE. fssFHERENattach () 将 数据 集 附 加 至 搜索 路 径 ， 在 评估 区 量 时 将 搜索 数据 集 ，MarkovSwitchData 为 函数 的 输 


入 参数 : 


> attach (MarkovSwitchData) 


输出 数据 框 MarkovSwitchData。 使 用 函数 head () 返回 数据 框 MarkovSwitchData 的 头 部 数据 ，MarkovSwitchData 数 
据 框 作为 函数 的 输入 参数 : 


> head (MarkovSwitchData) 


结果 如 下 : 


DATE LRY LRV INT LRC LYS LGS 
1 1997Q3 11.49 6.74 10.73 13.35 
2 199704 11.51 12.97 11.09 13.33 
3 199801 11.44 13.41 12.45 13.30 
4 199802 11.42 34.26 13.51 13.31 
3 199803 11.39 33.71 12.55 13.28 
6 199804 11.39 3.54 10.00 13.31 
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探索 数据 框 MarkovSwitchData 的 维度 。 使 用 dim () 国 数 返回 数据 框 MarkovSwitchData 的 维度 ，MarkovSwitchData 作 
为 国 数 的 输入 参数 。 返 回 结果 清楚 地 显示 数据 框 有 66 行 和 7 人 列 : 


> dim(MarkovSwitchData) 


结果 如 下 : 


[1] 66 7 


输出 数据 框 MarkovSwitchData 的 概要 。summary () 国 数 是 一 个 多 用 途 通用 函数 ， 提 供与 单个 对 象 或 数据 框 相 关 的 数据 
概要 。 数 据 框 MarkovSwitchData 为 summary () 函数 的 输入 参数 : 


> summary (MarkovSwitchData) 


结果 如 下 : 


— LRY 
199/703 : 1 Min «11. 39 
199704 : 1 1st Qu. (11.57 
199801 : 1 Median :11.83 
19980? : 1 Mean :11. 80 
199803 : 1 3rd Qu. :12.00 
199804 1 Max :12.21 
παν: -60 

LGS 

Min. :3. 360 
lst Qu. «3. 833 
Median :3.935 
Mean :3.978 
3rd Qu. :4.140 
Max. :4. 900 


第 3 步 : 准备 回归 模型 


为 数据 集 准 备 回 归 模 型 。 当 认为 两 个 或 多 个 变量 通过 线性 关系 系统 地 连接 时 ， 可 以 使 用 回归 分 析 。 回 归 模 型 用 于 从 一 


LRV 
Min. : 0.1100 
lst Qu.: 0.3125 
Median : 0.6100 


Mean : 1.9211 
3rd Qu.: 1.5275 
Max. :33. 7100 


INT 
Min. : 4.520 
lst Qu.: 5.015 
Median : 6.215 
Mean : 6.619 
3rd Qu.: 7.025 
Max. :13. 510 


预测 另 一 个 变量 。 它 们 根据 信息 提供 关于 过 去 、 现 在 和 未 来 事件 的 预测 。 


使 用 遂 数 cbind () 定义 因 变 量 ， 


> yLogValueStocks «- cbind(LVS) 


输出 数据 框 yLogValueStocks。 使 用 国 数 head () i 


的 输入 参数 : 


> head(yLogValueStocks) 


结果 如 下 : 
LYS 
[1,] 4.95 
[2,] 4.63 
[3,] 4.36 
[4,] 4.55 
[5,] 4.05 
[6,] 3.90 


Μα κερίπά () 采用 数据 框 LGS9， 结 果 仓 储 人 在 数据 框 yLogGrowthstocks 中 。 


输出 数据 框 yLogGrowthStocks。 使 用 函数 head () i 


孙 数 的 输入 参数: 


> head(yLogGrowthStocks) 


结果 如 下 : 


LRC 

= 
"23. 
23.3. 
243.3. 
:13. 
:13. 


Min. 


lst Qu. 


Median 
Mean 


3rd Qu. 


Max. 


22 
31 
36 
43 
54 
85 


ERZAGKFHAXETELVS, £átRCHCERIEyLogValueStocksrh: 


LVS 


Min. 


lst Qu.: 


median 
Mean 


3rd Qu.: 


Max. 


CETE 


个 变量 


返回 数据 框 yLogValuestocks 的 头 部 数据 ，yLogValuestocks 作 为 函数 


返回 数据 框 yYLogGrowthStocks 的 头 部 数据 ，yLogGrowthStocks 作 为 


[1,] 4. 90 
[2,] 4.43 
[3,] 3.99 
[4,] 4.20 
[5,] 3.83 
[6,] 3.36 
使 用 函数 cbind () 定义 自 变 量 ， 消 数 接受 数据 框 LRY、LRC、1INT 和 LRV， 结 果 存 储 在 数据 框 x 中 : 


> x «- cbind(LRY, LRC, INT, LRV) 


创建 一 个 普通 最 小 二 乘 (ordinary least square, OLS) 回归 方程 。 使 用 函数 Im () 拟 合 线性 模型 ， 由 yLogValuesStocks ~ 
x 表示 要 拟 合 的 模型 ， 结 果 存 储 在 数据 框 olsLogValueStocks 中 : 


> olsLogValueStocks <- lm(yLogValueStocks-x) 


输出 数据 框 olsLogValuestocks 的 概要 。summary () HAE CZAAR, fam XI STETABIS UE 
概要 。 数 据 框 olsLogValuestocks 为 Summary () 为 数 的 输入 参数 : 


> summary(olsLogValueStocks) 


结果 如 下 : 


Call: 
Im(formula = yLogvaluestocks ~ x) 


Residuals: 
Min 10 Median 30 Max 
-0. 57390 -0.07711 -0.00725 0.07179 0.319578 


coefficients: 
Estimate Std. Error t value Pr(»|t|) 
(Intercept) -9.151035 1.950114 -4.693 1.57e-05 *** 


κι ΕΥ 1.043820 0.200840 5.197 2.48e-06 *** 
XLRC 0.123601 0. 210845 0.586 0.5599 
XINT 0.013357 0. 020907 0.039 — 0.5253 
XLRV -0.012112 0.005686 -2.130 0.0372 * 


Signif. codes: ο '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1" ' 1 


Residual standard error: 0.1431 on 61 degrees of freedom 
Multiple R-squared: 0.8042, Adjusted R-squared: 0.7914 
F-statistic: 62.64 on 4 and 61 DF, p-value: < 2.2e-16 


创建 一 个 普通 最 小 二 乘 回归 方程 。 由 yLogGrowthstocks ~ x 表示 要 拟 合 的 模型 ， 结 果 存 储 在 数据 框 olsLogGrowthStocks 
rR: 


> olsLogGrowthStocks <- lm(yLogGrowthStocks-x) 


输出 数据 框 olsLogGrowthstocks 的 概要 。 数 据 框 olsLogGrowthstocks 为 Summary () 函数 的 输入 参数 : 


> summary (olsLogGrowthStocks) 


结果 如 下 : 


Call: 


Im(formula = yLogGrowthstocks ~ x) 
Residuals: 

Min 1η Median 3Q Max 
-0.62267 -0.11945 0.01245 0.07490 0.78002 
Coefficients: 

Estimate 5td. Error t value Pr (-|t |) 
(Intercept) -7.711885 2.663863 -2.895 0.00525 ** 
XLRY 0.827857 0.274348 3.018 0.00371 ** 
XLRC 0.089680 0.288015 0.311 0.756058 
XINT 0.110447 0.028559 3.867 0.00027 *** 
XLRV -0. 009277 0.007767 -1.194 0.23691 
signif. codes: ο '***' 0.001 '**' 0.01 '*' 0.05 - 0.1 ' ' 1 


Residual standard error: 
Multiple R-squared: 0.2924, 
F-statistic: 6.303 on 4 and 61 DF, 


第 4 步 : 准备 马尔 可 夫 转 移 模型 


马尔 可 夫 转 移 模型 涉及 可 以 表征 不 同 区 制 下 时 间 序列 行为 的 多 个 方程 。 该 模型 


式 。 状 态 变量 的 当前 值 取决 于 马尔 可 夫 属 性 控制 的 即时 过 去 值 。 


创建 股票 值 的 马尔 可 夫 转 移 模型 。 阔 数 msmFit () 使 用 EM 算 


对 和 象 类 ，k= 2 表示 估计 的 区 制 数量 ， 


> MarkovSwtchLogValueStocks «- msmFit(olsLogValueStocks, k = 2, 


rep(TRUE, ϐ)) 


输出 数据 框 MarkovSwtchLogValuestocks 的 概要 。 数 据 框 MarkovSwtchLogValueSstocks 为 Summary () È 


> summary (MarkovSwtchLogValueStocks) 


结果 如 下 : 


0.1954 on 61 degrees of freedom 
Adjusted R-squared: 
p-value: 0.0002596 


0.246 


E 够 通过 在 结构 之 间 转 移 来 捕获 复杂 的 动态 模 


算法 实现 马尔 可 夫 转 移 模型 ，olsLogValueStocks 是 Im 类 型 的 
结果 存储 在 数据 框 MarkovSwtchLogValueStocks 中 : 
SW = 
函数 的 输入 参 


Markov Switching Model 


Call: msmFit(object = olsLogvaluestocks, k = 2, sw = rep(TRUE, 6)) 


AIC BIC — logLik 
-102.0478 -38.25474 61.02392 
coefficients: 
Regime 1 


Estimate 5td. Error t value Pr(>|t|) 


(intercept)(5) -10.7330 0.5460 -19.6575 < 2.2e-16 *** 
XLRY( 5) 1.6984 0.0303 256.0528 < 2.2e-16 *** 
XLRC(5) -0.3478 0.0414 -8.4010 < 2.2e-16 *** 
XINT(5) 0.0411 0.0020 20.5500 < 2.2e-16 *** 
XLRV(5) -0.0139 0.0015 -9.2667 < 2.2e-16 *** 


siqnif. codes: 0O '***'" 0.001 '**" 0.01 "*" 005 "." 0.1 " "1 


Residual standard error: 0.03610862 
Multiple R-squared: 0.9893 


standardized Residuals: 
Min Ql Med 03 Max 
-8.340128e-02 -1.065220e-02 -3.0682609e-16 1.117322e-02 7.650599e-02 


Regime 2 

Estimate 5td. Error t value Pr(»|t|) 
(rntercept)(5) 13.6836 2.1896 6.2494 4.120e-10 *** 
xLRY(5) 0.7522 0.1799 4.1812 2.900e-05 *** 
XLRC(S) -1.2801 0.1608 -7.9608 1.776e-15 *** 
XINT(5) -0.1005 0.0388 -2.5902 0.009592 ** 
XLRV(5) 0.0487 0.0201 2.4229 0.015397 * 


Signif. codes: ο '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1" ' 1 
Residual standard error: 0.1515668 
Multiple R-squared: 0.5145 


Standardized Residuals: 
Min Q1 Med Q3 Max 
-0. 48074613 -0.02481690 0.00113687 0.02751167 20O0.46264470 


Transition probabilities: 
Regime 1 Regime 2 


Regime 1 0. 82355604 0.1692358 
Regime 2 0.1744396 0.8307642 


PERKARA RRE, BREXmsmFit () 使 用 EM 算法 实现 马尔 可 夫 转 移 模 型 ，olsLogGrowthStocks 是 Im 类 型 的 
对 象 类 ,k=2 表 示 估 计 的 区 制 数量 ,结果 和 存储 在 数据 框 MarkoSwtchLogGrowthStocks 中 : 


> MarkoSwtchLogGrowthStocks«- msmFit(olsLogGrowthStocks, k = 2, sw = 
rep(TRUE, 6)) 


输出 数据 框 MarkoSwtchLogGrowthStocksdata 的 概要 。 数 据 框 MarkoSswtchLogGrowthStocksdata 为 Ummary () Pf 
数 的 输入 参数 : 


> summary (MarkoSwtchLogGrowthStocks) 


结果 如 下 : 


Markov switching Model 
Call: msmrFit(object = olsLogcrowthstocks, k = 2, sw = rep(TRUE, 6)) 


AIC BIC  logLik 
-65.43317 -1.640072 42.71658 


coefficients: 


Estimate στα. Error t value Prí(-|t|) 
(Intercept)(S) 14.9726 4.1217 3.6326 0.0002806 *** 


XLRY(S) 1.4894 0.3053 4.8785 1.069e-06 "τν 
XLRC(S) -2.1932 0.2741 -8.0015 1.332e-15 *** 
XINT(S) 0.1022 0.0651 31.5699 0.1164384 
XLRV(S) 0.0466 0.0309 31.5081 0.1315289 


SIgn. DOGS: ο “ουο τοσο "*" 003 77T 5.1." “α 


Residual standard error: Ο. 23476528 
Multiple R-squared: 0.4281 


Standardized Residuals: 
Min Q1 Med Q3 Max 
-0. 573535743 -0.021589934 0.004829526 0.018767748 30O0.6813470620 


Estimate στα. Error t value Pr(-|tl|) 
(Intercept) (s) -8.5099 0. 8361 -10.1781 < 2.2e-16 *** 


XLRY(S) 0.5287 0.0940 5.6245 1.860e-08 *** 
XLRC(S) 0.4282 0.0871 4.9162 8.824e-07 *** 
XINT(S) 0.0718 0.0100 7.1800 6.972e-13 *** 
XLRV(S) -0.0081 0.0029 -2.7931 0.005221 ** 


signif. codes: ο '***' 0.001 '**" 0.01 '*' 0.05 '.'" 0.1 ' ' 1 


Residual standard error: 0.0676098 
Multiple R-squared: 0. 803 


standardized Residuals: 

Min Q1 Med Q3 Max 
-1.356430e-01 -2.402493ie-0?  6.0/6829e-06 3.124204e-0?2 1.493800e-01 
Transition probabilities: 

Regime 1 Regime 2 


Regime 1 0.8809933 0.08517424 
Regime 2 0.1190067 0.91482576 


第 5 步 : 绘制 区 制 概率 
下 面 绘制 已 计算 的 区 制 概率 。 
绘制 股票 值 的 区 制 概率 。 阔 数 par () 用 于 查询 图 形 参 数 : 


> par (mar=c (3,3,3,3)) 


国 数 plotProb () 为 每 个 区 制 创建 一 个 图 ， 包 含 平滑 和 过 滤 的 概率 。MarkovSwtchLogValueStocks 作 为 MSM.Im 类 型 的 


对 象 传递 给 函数 ，which = 1 表示 所 需 图 的 子 集 ， 使 用 以 下 命令 : 


> plotProb(MarkovSwtchLogValueStocks, which-1) 


结果 如 下 : 
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国 数 plotProb () 为 每 个 区 制 创建 一 个 图 ， 包 含 平滑 和 过 滤 的 概率 。MarkovSwtchLogValueStocks 作 为 MSM.Im 类 型 的 
对 象 传递 给 函数 ，which = 2 表示 具有 响应 变量 的 区 制 与 平滑 概率 的 关系 曲线 。 使 用 以 下 命令 : 


> plotProb(MarkovSwtchLogValueStocks, which-2) 
结果 如 下 : 
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国 数 plotProb () 为 每 个 区 制 创 建 一 个 图 。MarkoSwtchLogGrowthStocks 作 为 MSM.Im 类 型 的 对 象 传递 给 函 
which=1 表 示 所 需 图 的 子 集 : 
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> plotProb (MarkoSwtchLogGrowthStocks, which-1) 


结果 如 下 : 
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函数 plotProb () 为 每 个 区 制 创 建 一 个 图 。MarkoSwtchLogGrowthStocks 作 为 MSM.Im 类 型 的 对 象 传递 给 函 
数 ，which=2 表 示 有 具有 响应 变量 的 区 制 与 平滑 概率 的 关系 曲线 。 使 用 以 下 命令 : 


> plotProb (MarkoSwtchLogGrowthStocks, which=2) 


结果 如 下 : 
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第 6 步 : 测试 马尔 可 夫 转 移 模型 
接 下 来 ， 将 对 马尔 可 夫 转 移 模 型 运行 诊断 测试 。 
绘制 股票 值 的 区 制 概率 。 阔 数 par () 用 于 查询 图 形 参 数 : 


> par (mar=c (3,3,3,3)) 


创建 残 差 分 析 图 。 函 数 plotDiag () 根据 拟 合 值 绘制 残 差 。MarkovSwtchLogValueStocks 作 为 MSM.Im 类 型 的 对 象 传递 
给 函数 ，which=1 表 示 所 需 图 的 子 集 ， 并 根据 拟 合 值 绘制 残 差 : 


> plotDiag(MarkovSwtchLogValueStocks, regime-1, which-1) 


结果 如 下 : 
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函数 plotDiag () 为 每 个 区 制 创建 一 个 图 。MarkoSwtchLogGrowthStocks 作 为 MSM.Im 类 型 的 对 象 传递 给 函 
which=2 表 示 绘 制 正 态 Q-Q 图 : 
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» plotDiag(MarkovSwtchLogValueStocks, regime-1, which-2) 


结果 如 下 : 
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国 数 plotDiag () 为 每 个 区 制 创建 一 个 图 。MarkoSwtchLogGrowthStocks 作 为 MSM.Im 类 型 的 对 象 传递 给 函 
数 ，which = 3 表示 残 差 的 ACF/PACF 和 平方 残 差 的 ACF/PACF : 


> plotDiag(MarkoSwtchLogGrowthStocks, regime-1, which-3) 


结果 如 下 : 


ACF 残 差 (Reg: 1) PACF 225: (Reg: 1) 
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函数 plotDiag () 根据 拟 合 值 绘制 残 差 。MarkoSswtchLogGrowthStocks 作 为 MSM.Im 类 型 的 对 象 传递 给 函数 ，which=1 
表示 所 需 图 的 子 集 ， 并 根据 拟 合 值 绘制 残 差 : 


> plotDiag (MarkoSwtchLogGrowthStocks, regime=1, which=1) 


结果 如 下 : 
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国 数 plotDiag () 为 每 个 区 制 创建 一 个 图 。MarkoSwtchLogGrowthStocks 作 为 MSM.Im 类 型 的 对 象 传递 给 函 
which = 2 表示 绘制 正 态 Q-Q 图 : 
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> plotDiag(MarkoSwtchLogGrowthStocks, regime-1, which-2) 
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函数 plotDiag () 为 每 个 区 制 创建 一 个 图 。MarkoSwtchLogGrowthStocks 作 为 MSM.Im 类 型 的 对 象 传递 给 函 
数 ，which = 3 表示 残 差 的 ACF/PACF 和 平方 残 差 的 ACF/PACF : 


> plotDiag(MarkoSwtchLogGrowthStocks, regime-1, which-3) 


结果 如 下 : 


ACF 残 差 (Reg: 1) PACF 5X2* (Reg: 1) 





83 ”马尔 可 夫 链 : RIBUS 


在 电子 商务 网 站 上 购物 之 前 ， 客 户 旅程 将 经 历 不 同 渠 道 的 路 径 。 多 渠道 归 因 为 旅 程 中 的 每 个 步骤 分 配 一 个 值 。 问 题 是 如 何 识 
别人 们 在 你 的 网 站 上 促进 转化 的 行为 的 价值 。 通 常 ， 企 业 使 用 “最 后 点 击 ” 归 因 (这 意味 着 将 所 有 转化 价值 分 配 到 旅程 的 最 后 一 
步 ) 或 “ 曾 次 后 击 ” 归 因 。 开 友 多 渠道 归 因 分 析 的 第 一 步 是 了 解 客 尸 的 旅程 一 一 从 意识 到 米 购 到 售后 支持 。 最 终 目标 是 培养 花 
费 大 量 资金 购物 的 忠实 客户 ， 将 品牌 推荐 给 他人， 并 可 能 成 为 品牌 。 


准备 工作 
我 们 模拟 三 个 不 同 渠道 的 客户 旅程 来 搭建 马尔 可 夫 链 多 渠道 归 因 模型 。 
具体 实施 步骤 


以 下 为 实现 细节 。 
第 1 步 : 准备 数据 集 


首先 需要 加 载 以 下 软件 包 : 


install.packages("dplyr") 
install.packages("reshape2") 
install.packages ("ggplot2") 
install.packages("ChannelAttribution") 
install.packages("markovchain") 


V V V V V 


library (dplyr) 

library (reshape2) 

library (ggplot2) 

library (ChannelAttribution) 
library (markovchain) 


V V V V V 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.2.2 (2015-08-14) 。 


创建 数据 样本 。 使 用 函数 c () 组 合 参 数 以 形成 同 量 。 传 递 给 函数 的 所 有 参数 都 将 组 合成 一 个 通用 类 型 ， 即 返回 值 的 类 型 。 
PE data.frame () 创建 一 个 紧密 厅 合 的 数据 框 ， 它 是 共享 算 阵 和 列表 的 许多 属性 的 变量 集合 。 数 据 保存 在 数据 框 datafrm1 


> datafrml <- data.frame(path = c('cl > c2» οὗ, 'c1', 'c2 > c3"), 
conv = c(1, 0, 0), conv null s c(0, 1, 1)) 


输出 数据 框 datafrm1: 


> datafrml 


结果 如 下 : 


path conv conv null 


1 cl > c2 > c3 1 0 
2 c1 0 1 
3 C2 > C3 0 1 


第 2 步 : 准备 模型 


准备 马尔 可 夫 模 型 。 销 数 markov_model () 从 客户 旅程 数据 中 估计 K 阶 马尔 可 夫 模 型 。 数 据 框 qatafrm1 包 含 了 定义 的 客户 
旅程 ， 变 量 var_path 具 有 包含 旅程 路 径 的 列 的 名 称 ， 变 量 var_conv 表 示 包 含 所 有 转化 的 列 的 名 称 ，var_null 变 量 表 示 包 含 所 有 未 
转换 的 路 径 的 列 ，out_more=TRUE 返 回 渠道 和 输出 效果 之 间 的 转换 概率 。 


估计 k 阶 马尔 可 夫 模 型 的 结果 保存 在 数据 框 model1 中 : 


> modell1 <- markov model (datafrml, var path = 'path', var conv = 
'conv', var null - 'conv null', out more - TRUE) 
输出 数据 框 model1 : 
> modell 


结果 如 下 : 


$result 
channel name total conversions 


1 c1 0. 2001447 

2 C2 0. 3999276 

3 c3 0. 3999276 

$transition matrix 

channel from . channel to transition probability 

1 (start) c1 ο. 6666667 

2 (start) c? 0. 3333333 
3 (1 C2 0. 5000000 
4 c1 (null) 0. 5000000 
5 c2 c3 1. 0000000 
6 c3 (conversion) 0. 5000000 
7 c3 (null) 0. 5000000 


$removal effects 
channel name removal effects 


1 (1 0. 5004524 
2 c2 1.0000000 
3 c3 1. 0000000 


从 数据 框 model1 中 提取 结果 归 因 ， 和 存储 在 数据 框 datafrmresult1 中 : 


> datafr(BS)y1l$result 


从 数据 框 model1 中 提取 transition_matrix 归 因 ， 和 存储 在 数据 框 datafrmtransmatrix1 中 : 


> datafrmtransmatrix1 <- modell$transition matrix 


重 塑 数据 框 。 重 塑 的 数据 框 存储 在 数据 框 datafrmtransmatrix 中 : 


> datafrmtransmatrix <- dcast(datafrmtransmatrix1, channel from ~ 
channel to, value.var = 'transition probability') 


输出 数据 框 datafrmtransmatrix: 


> datafrmtransmatrix 


结果 如 下 : 

channel from (conversion) (null) c1 c2 c3 
1 (start) NA MA 0.666666/ 0.3333333 NA 
2 C1 NA 0.5 NA 0. 5000000 NA 
3 C2 ΝΑ ΝΑ ΝΑ NA 1 
4 c3 0.5 0.5 NA NA NA 


第 3 步 : 绘制 马尔 可 夫 图 像 
从 数据 框 model1 中 提取 transition_matrix 归 因 ， 和 存储 在 数据 框 datafrmtransmatrix 中 : 


> datafrmtransmatrix <- modell$transition matrix 


输出 数据 框 datafrmtransmatrix: 


> datafrmtransmatrix 


结果 如 下 : 

channel from channel_to transition probability 
1 (start) c1 0.6666667 
2 (start) c2 0. 3333333 
3 c1 c2 0. 5000000 
4 c1 (null) 0. 5000000 
5 c2 c3 1. 0000000 
6 c3 (conversion) 0. 5000000 
7 c3 (null) 0. 5000000 


创建 数据 样本 datafrmdummy。 使 用 函数 c () BAS% EASRA REA MKE, 
ΒΠΙΡΙΗΙΒΗΊΞΕ3Η. BEEXdata.frame () 创建 一 个 崇 密 硒 合 的 数据 框 ， 它 是 共享 算 阵 和 列表 的 许多 属性 的 变量 集合 。 数 据 保存 在 
数据 框 datafrmdummy 中 : 


> datafrmdummy «- data.frame(channel from = c('(start)', 
'(conversion)', '(nul11)'), channel to = c('(start)', '(conversion)', 
'(nu11)'), transition probability = c(0, 1, 1)) 


输出 数据 框 datafrmdummy 


>datafrmdummy 
结果 如 下 : 
channel from channel_to transition probability 
1 (start) (start) 0 
2 (conversion) (conversion) 1 
3 (nu11) (nu11) 1 


整合 列 。 函 数 rbind () 获取 并 整合 数据 框 的 序列 ，datafrmtransmatrix 和 df dummy 为 数据 参数 ， 结 果 保存 在 数据 框 


datafrmtransmatrix 中 : 


> datafrmtransmatrix «- rbind(datafrmtransmatrix, datafrmdummy) 


输出 数据 框 datafrmtransmatrix: 


> datafrmtransmatrix 


结果 如 下 : 


- 


channel from | channel to transition probability 


1 (start) C1 0. 6666667 
2 (start) C2 0.3333333 
3 cl c2 0. 5000000 
4 c1 (null) ο. 5000000 
5 c2 c3 1.0000000 
6 c3 (conversion) 0. 5000000 
7 c3 (null) 0. 5000000 
8 (start) (start) ο. 0000000 
9 (conversion) (conversion) 1.0000000 
10 (null) (null) 1. 0000000 


为 渠道 排序 。 使 用 函数 factor () 将 向 量 datafrmtransmatrix$channel from 编 码 为 一 个 因 
levels=c (' (start) ', ' (conversion) ', ' (null) ', 'c1', 'c2', 'c3') 代表 值 的 一 个 可 选 向 量 : 


> datafrmtransmatrix$channel from <- 
factor(datafrmtransmatrix$channel from, levels = c('(start)', 
' (conversion)', '(null)', 'c1', 'c2', 'c3')) 


输出 数据 框 datafrmtransmatrix$channel from: 


> datafrmtransmatrix$channel from 


结果 如 下 : 


[1] (start) (start) c1 c1 c2 c3 c3 (start) (conversion) 
[10] (null) 
Levels: (start) (conversion) (null) c1 c2 c3 


为 渠道 排序 。 使 用 函数 factor () 将 向 量 datafrmtransmatrix$channel to 编码 为 一 个 因子 : 


> datafrmtransmatrix$channel to <- 
factor(datafrmtransmatrix$channel to, levels - c('(start)', '(conversion)', 
παν σι σοι ΕΠ} 


输出 数据 框 datafrmtransmatrix$channel to: 


> datafrmtransmatrix$channel to 


结果 如 下 : 


[1] a c? c? (null) c3 (conversion) (null) (start) 
[9] (conversion) (null) 
Levels: (start) (conversion) (null) c1 c2 c3 


重 塑 数据 框 。 结 果 保 存在 数据 框 qatafrmtransmatrix 中 : 


> datafrmtransmatrix <- dcast(datafrmtransmatrix, channel from ~ 
channel to, value.var - 'transition probability') 


输出 数据 框 datafrmtransmatrix: 


> datafrmt ransmatrix 


结果 如 下 : 


channel from (start) (conversion) (null) C1 C2 C3 
1 (start) 0 NA ΝΑ 0.6666667 0.3333333 NA 
2 (conversion) NA 1.0 NA NA ΜΑ ΝΑ 
3 (null) NA NA 1.0 NA NA NA 
4 ci NA NA 0.5 ΝΑ 0. 5000000 NA 
5 c? NA NA NA NA NA 1 
6 c3 NA 0.5 0.5 NA NA NA 


创建 马尔 可 夫 链 对 象 。 函 数 matrix () 使 用 给 定 值 的 集合 创建 德 阵 : 


> transitionmatrix <- matrix(data = as.matrix(datafrmtransmatrix[, 
-11), nrow = nrow(datafrmtransmatrix[, -1]), ncol = 
ncol(datafrmtransmatrix[, -1]), dimnames - list 
(c(as.character(datafrmtransmatrix[, 1])), c(colnames (datafrmtransmatrix[, 


-11)))) 


输出 数 握 框 transitionmatrix: 


> transitionmatrix 


结果 如 下 : 
(start) (conversion) (null) C1 C2 C3 
(start) 心 ΝΑ ΝΑ 0.666666/ 0.3333333 ΝΑ 
(conversion) NA 1.0 NA NA ΝΑ ΝΑ 
ΠΗ ΝΑ ΝΑ " NA ΝΑ ΝΑ 
(null) 1.0 
c1 NA NA 0.5 NA 0.5000000 NA 
c2 ΝΑ ΝΑ, ΝΑ ΝΑ ΝΑ 1 
C3 NA 0.5 0.5 NA NA NA 


> transitionmatrix[is.na(transitionmatrix)] <- 0 
创建 马尔 可 夫 链 对 象 。transitionMatrix 为 转换 矩阵 ， 所 有 项 为 概率 ， 行 或 列 求 和 为 1: 


> transitionmatrixl <- new("markovchain", transitionMatrix = 
transitionmatrix) 


输出 数 握 框 transitionmatrix1: 


> transitionmatrixi1 
结果 如 下 : 


Unnamed Markov chain 
A 6 - dimensional discrete Markov Chain defined by the following states: 
(start), (conversion), (null), c1, c2, c3 
The transition matrix (by rows) is defined as follows: 
(start) (conversion) (null) c1 C2 C3 


(start) 0 0.0 0.0 0.6666667 0.3333333 Ü 
(conversion) 0 1.0 0.0 0.0000000 0.0000000 O 
(nu11) 0 0.0 1.0 0.0000000 0.0000000 O 
c1 0 0.0 0.5 0.0000000 0.5000000 O 
C2 0 0.0 0.0 0.0000000 0.0000000 1 
(3 Ώ 0.5 0.5 0.0000000 0.0000000 O 


绘制 图 像 : 


> plot(transitionmatrixl1, edge.arrow.size = 0.5, main = "Markov Graph 
Transition Matrix - transitionmatrixl1") 


结果 如 下 : 


马尔 可 夫 转 移 和 矩阵 : transitionmatrixl 
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第 4 步 : 模拟 客户 旅程 的 数据 集 


EE data.frame () 创建 一 个 索 密 耦合 的 数据 框 ， 为 共享 起 孟 和 人 多 表 的 许多 属性 的 变量 集合 。 数 据 保 仔 人 在 数 据 框 qatafrm2 


> set.seed(354) 

> datafrm2 <- data.frame(client id = sample(c(1:1000), 5000, replace = 
TRUE), date - sample(c(1:32), 5000, replace - TRUE), channel - 
sample(c(0:9), 5000, replace - TRUE, prob - c(0.1, 0.15, 0.05, 0.07, 0.11, 
0.07, 0.13, 0,1, 0:06, ορ ο } 


输出 数据 框 datafrm2。 使 用 函数 head () 返回 数据 框 datafrm2 的 头 部 数据 ，datafrm2 作 为 遂 数 的 输入 参数 : 


> head(datafrm2) 


结果 如 下 : 


date 
2016-01-05 
2016-01-31 
2016-01-09 
2016-02-02 
2016-01-04 
2016-01-26 


client id 
411 
761 
509 
541 
156 
934 


σι Ln εν Lu ka F 


将 字符 对 象 转换 为 日 期 Date 对 象 。 


> datafrm2$date <- as. 


channel 


Go D ο ο C» Ln 


datafrm2$date 代 表 需 要 转换 的 特征 ，origin="2016-01-01" 代 表 Date 对 象 : 


Date (datafrm2$date, origin "2016-01-01") 


连接 转换 为 字符 的 向 量 ， 为 渠道 添加 channel 对 象 ，datafrm2$channel 代 表 数 据 框 : 


> datafrm2$channel <- pasteO('channel ', 


datafrm2$channel) 


输出 数据 框 datafrm2。 使 用 函数 head () 返回 数据 框 datafrm2 的 头 部 数据 ，datafrm2 作 为 函数 的 输入 参数 : 


> head(datafrm2) 


结果 如 下 : 


date 
2016-01-05 
2016-01-31 
2016-01-09 
2016-02-02 
2016-01-04 
2016-01-26 


client id 
411 


σι un T Lu nh rH 


> datafrm2 < 一 
paste (channel, 


输出 数据 框 datafrm2: 


> datafrm2 


结果 如 下 : 


collapse = ' > 


channel 
channel 5 
channel 6 
channel. 6 
channel 8 
channel. 9 
channel. 8 


datafrm2 %>% group by(client id) $»$ summarise (path 
'), conv Ξ 1, conv null 0) $»$ ungroup() 


# A tibble: 990 x 4 


client id 
«int- 
1 1 
2 2 
3 3 
4 4 
5 5 
6 6 
/ Fi 
8 8 
= 9 
10 10 
# ... with 980 more rows, and 3 more variables: path «chr-, conv «dbl-, conv null <db1> 


准备 马尔 可 夫 模 型 。 销 数 markov_model () 从 客 尸 旅程 数据 中 估计 Kk 阶 马 尔 可 夫 模 型 。 数 据 框 datafrm2 包 含 了 定义 的 客户 
旅程 ， 变 量 var_ path 具有 包含 旅程 路 径 的 列 的 名 称 ， 变 量 var_conv 表 示 包 含 所 有 转化 的 列 的 名 称 ， 变 量 var_null 表 示 包 含 所 有 未 
转换 的 路 径 的 列 ，out_more=TRUE 返 回 渠道 和 输出 效果 之 间 的 转换 概率 。 


估计 k 阶 马尔 可 夫 模 型 的 结果 保存 在 数据 框 model2 中 : 


> model2 «- markov model (datafrm2, var path = 'path', var conv = 
'conv', var null - 'conv null', out more - TRUE) 


> datafrmheuristic <- datafrm2 $»$ mutate(channel name ft = sub('».*', 
'', path), channel name ft = sub(' ', '', channel name ft), channel name lt 
= sub('.*»', '', path), channel name lt = sub(' ', '', channel name 1lt)) 


输出 数据 框 datafrmheuristic: 


> datafrmheuristic 


结果 如 下 : 
$ A tibble: 990 x 6 

client id path conv conv null 

«int» «chr» «dbl- <dbl> 

1 1 channel 3 1 0 
2 channel 4 > channel. 9 > channel 9 > channel 6 > channel 2 > channel 1 > channel 0 1 0 
3 3 channel 7 > channel 9 > channel 9 > channel 8 > channel 8 > channel 9 > channel 5 > channel 0 > channel 0 1 0 
4 4 channel 1 > channel 9 > channel 0 > channel 6 1 0 
5 5 channel 4 > channel 6 > channel 4 > channel 9 > channel 2 > channel 7 1 0 
6 6 channel 1 > channel 1 > channel 4 > channel 7 > channel 6 1 0 
7 7 channel. 6 > channel. 5 > channel. 6 > channel 6 > channel 7 > channel 7 > channel 6 1 0 
8 8 channel 4 > channel 5 > channel. 5 > channel. 3 > channel 5 > channel. 6 > channel 8 > channel 4 > channel 1 1 0 
9 9 channel 4 > channel 8 1 0 
10 10 channel. 0 > channel 4 > channel 1 > channel 1 1 0 
4 ... with 980 more rows, and 2 more variables: channel name ft «chr», channel name lt «chr» 


> datafrmfirsttouch <- datafrmheuristic $»$ group by(channel name ft) 
%>% summarise(first touch conversions = sum(conv)) $»$ ungroup() 


输出 数 握 框 dqatafrmfirsttouch : 


> datafrmfirsttouch 


结果 如 下 : 


Z A tibble: 10 x 2 


channel name ft first touch conversions 


«chr «db 1-- 
1 channel Ὁ 82 
2 channel 1 159 
3 channel. 2 60 
4 channel. 3 71 
5 channel Δ 102 
6 channel 5 75 
7 channel 6 142 
8 channel 7 83 
9 channel 8 50 
10 channel. 9 166 
> datafrmlasttouch <- datafrmheuristic $»$ group by(channel name lt) 
%>% summarise(last touch conversions = sum(conv)) $»$ ungroup() 


输出 数据 框 datafrmfirsttouch: 


> datafrmfirsttouch 


结果 如 下 : 


# A tibble: 10 x 2 
channel name lt last touch conversions 


«chr <db1> 
1 channel 0 92 
2 channel 1 166 
3 channel. 2 50 
4 channel_3 71 
5 channel_4 114 
6 channel_s5 64 
7 channel 6 139 
8 channel 7 88 
q channel_8 46 
10 channel_9 160 
按 公共 列 合并 两 个 数据 框 ， 结 果 保 存在 数据 框 heuristicmodel2 中 : 


> heuristicmodel2 «- merge (datafrmfirsttouch, datafrmlasttouch, by.x = 
'channel name ft', by.y = 'channel name 1lt') 


输出 数据 框 heuristicmodel2: 


> heuristicmodel2 


结果 如 下 : 

channel. name ft first touch conversions last touch conversions 
1 channel 0 82 92 
2 channel 1 159 166 
3 channel 2 60 50 
4 channel. 3 71 71 
5 channe]1. 4 102 114 
6 channel. 5 75 64 
7 channel. 6 142 139 
8 channel 7 83 88 
g channel 8 50 46 
10 channel 9 166 160 


合并 所 有 模型 : 


> allmodels <- merge(heuristicmodel12, model2S$result, by.x = 
'channel name ft', by.y = 'channel, name') 


输出 数据 框 allmodels: 


> allmodels 


结果 如 下 : 


channel. name ft first touch conversions last touch conversions total. conversions 


1 channel O 82 92 97.59677 
2 channel 1 159 166 139.07908 
3 channel. 2 60 50 57.98764 
4 channel. 3 71 1 73. 53247 
5 channe1_4 102 114 110.94456 
6 channel. 5 75 64 82.25067 
7 channel. 6 142 139 126.11034 
8 channel. 7 83 88 98. 86641 
9 channel. 8 50 46 65.69749 
10 channel. 9 166 160 137.93456 


第 5 步 : JILA EE HAB MERE 
绘制 热 图 : 


> colnames(allmodels) [c (1, 4)] <- c('channe1l name', 
'attrib model conversions') 

> datafrmplottransition <- model2$transition matrix 

> cols <- c("i4e7f0fa", "#c9e2f6", "#95cbee", "#0099dc", "#4ab04a", 
"Hffd73e", "#eec73a", "4929421", "4929421", "$4f05336", "ice472e") 


返回 数据 框 datafrmplottransition$transition probability 存 在 的 所 有 参数 的 最 大 值 : 


> t <— max(datafrmplottransition$transition probability) 


输出 t 的 值 : 


结果 如 下 : 


[1] 0.2391931 


> ggplot(datafrmplottransition, aes(y = channel from, x = channel to, 
fill = transition probability)) + theme minimal() + geom tile(colour = 
"white", width = .9, height = .9) + scale fill gradientn(colours = cols, 
limits = c(0, t), breaks = seq(0, t, by = t/4), labels = c("O", 
round(t/4*1, 2), round(t/4*2, 2), round(t/4*3, 2), round(t/4*4, 2)), guide 
= guide colourbar(ticks = T, nbin = 50, barheight = .5, label = T, barwidth 
= 10)) + geom text (aes (label = round(transition probability, 2)), fontface 
= "bold", size = 4) + theme(legend.position = 'bottom', legend.direction = 
"horizontal", panel.grid.major - element blank(), panel.grid.minor - 
element blank(), plot.title - element text(size - 20, face - "bold", vjust 
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= 2, color = 'black', lineheight = 0.8), axis.title.x = element text (size = 
24, face - "bold"), axis.title.y - element text(size - 24, face - "bold"), 
axis.text.y = element text(size = 8, face = "bold", color = 'black'), 
axis.text.x = element text(size = 8, angle = 90, hjust = 0.5, vjust = 0.5, 
face = "plain")) + ggtitle("Heatmap - Transition Matrix ") 
结果 如 下 : 
热度 图 : PIERE 

T "- EE o 0 NN o EN ο 

κ. o SN K. 
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84 ”马尔 可 夫 链 : 汽车 租赁 代理 服务 


假设 一 家 汽车 租赁 公司 在 涯 太 华 有 三 个 地 点 : 市 区 ( 标 为 A) 、 东 区 ( 标 为 B) 和 西区 ( 标 为 C) 。 该 代理 有 一 组 送 货 司 机 ， 
可 以 为 三 个 地 点 提供 服务 。 该 代理 的 统计 人 员 确 定 了 以 下 内 容 : 


` 在 市 区 的 需求 中 ，30% 在 市 区 交付 ，30% 在 东区 交付 ，40% 在 西区 交付 
“在 东区 的 需求 中 ，40% 在 市 区 交付 ，40% 在 东区 交付 ，20% 在 西区 交付 


: 在 西区 的 需求 中 ，50% 在 市 区 交付 ，30% 在 东区 交付 ，20% 在 西区 交付 


在 完成 一 次 交付 后 ， 司 机 去 最 近 的 点 完成 下 一 次 交付 。 这 样 ， 一 位 指定 司机 的 位 置 仅 由 他 之 前 的 位 置 确定 。 


以 下 为 实现 细节 。 
第 1 步 : 准备 数据 集 
首先 需要 加 载 以 下 软件 包 : 


> install.packages("markovchain") 
> library (markovchain) 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.2.2 (2015-08-14) 。 


创建 数据 样本 。 使 用 为数 c () 组 合 参 数 以 形成 向 量 。 传 递 给 函数 的 所 有 参数 都 将 被 组 合成 一 个 通用 类 型 ， 即 返回 值 的 类 
型 。 数 据 保 存在 数据 框 RentalStates 中 : 


> RentalStates «- c("Downtown", "East", "West") 


输出 RentalStates 的 值 : 


> RentalStates 


结果 如 下 : 


[1] "Downtown" "East" "west" 


SUBE, BÉEXmatrix () SEFHÉGRERSIBBUSEGIGIEEXBER. byrow- TUBE TAE, nrow-3fUznsEERU (T2. ΜΕΝ 
c 0 组 合 参数 以 形成 向 量 。 传 递 给 函数 的 所 有 参数 都 将 被 组 合成 一 个 通用 类 型 ， 即 返回 值 的 类 型 : 


> RentalTransitionMatrix «- matrix(c(0.3, 0.3, 0.4, 
0.4, 0.4, 0.2, 
ο ος ἅς 9.2), 
byrow = T, nrow = 3, dimnames = list(RentalStates, RentalStates)) 


输出 RentalTransitionMatrix 的 值 : 


> RentalTransitionMatrix 


结果 如 下 : 


Downtown East West 


Downtown 0.3 0.3 0.4 
East 0.4 0.4 0.2 
West 0.5 0.3 0.2 


第 2 步 : 准备 模型 


创建 马尔 可 夫 链 模型 。 函 数 new () 创建 markovchain 类 型 的 对 象 ， 状 态 为 以 前 定义 的 RentalSstates。byrow=T 表 示 矩 阵 


按 行 填充 ， 结 果 保 存在 数据 框 mcRental 中 : 


> mcRental «- new("markovchain", states = RentalStates, byrow = T, 
transitionMatrix - RentalTransitionMatrix, name - "Rental Cars") 


输出 数据 框 mcRental : 


> mcRental 


结果 如 下 : 


Rental Cars 
A 3 - dimensional discrere Markov chain defined by the following states: 


Downtown, East, West 
The transition matrix (by rows) is defined as follows: 


Downtown East West 


Downtown 0.3 0.3 0.4 
East 0.4 0.4 0.2 
West 0.5 0.3 0.2 


通过 调用 对 象 mcRental 来 访问 转换 矩阵 : 


> mcRental[2] 


结果 如 下 : 
Downtown East West 
0.4 0.4 0.2 


*I^ 


绘制 对 象 mcRental。plot () 为 绘制 R 对 象 的 通用 函数 : 


> plot (mcRental) 


结果 如 下 : 





计算 转换 概率 。transitionProbability () 可 以 直接 访问 转换 概率 : 


> transitionProbability (mcRental, 
结果 如 下 : 


[11 0.2 


计算 两 次 行程 都 在 市 区 的 概率 (市 区 至 市 区 ) : 
> x <- 0.3 * 0.3 


计算 从 东区 到 市 区 的 概率 (东区 至 市 区 ) : 
ΣΥ < 0.3 * 0.4 


计算 从 西区 到 市 区 的 概率 (西区 至 市 区 ) : 


> z <— 0.4 * 0.5 
> x + y + z 


"East, 


"West") 


结果 如 下 : 
[1] 0.41 


将 和 矩阵 mcRental 平 方 来 计算 两 次 行程 在 市 区 的 概率 : 


> mcRental ^ 2 


结果 如 下 : 


Rental CarsAz 
A 3 - dimensional discrete Markov chain defined by the following states: 
Downtown, East, West 
The transition matrix (by rows) is defined as follows: 
Downtown East West 


Downtown 0.41 0.33 0.26 
East 0.38 0.34 0.28 
West 0.37 0.33 0.30 


fssRmcRenta 4B EEISESSTT EXE ds 207X tfr Erb ECRIRE : 


> mcRental ^ 20 


结果 如 下 : 


Rental CarsA20 

A 3 - dimensional discrete Markov chain defined by the following states: 
Downtown, East, West 

The transition matrix (by rows) is defined as follows: 


Downtown East West 
Downtown O. 3888889 0.3333333 0.2777778 
East 0.3888889 0.3333333 0.2777778 
West 0.3888889 0.3333333 0.2777778 


fssRdmcRenta 4B EEISESSTT E32 d 307X ti fr ter KANAE : 


> mcRental ^ 30 


结果 如 下 : 


Rental CarsA30 

A 3 - dimensional discrete Markov chain defined by the following states: 
Downtown, East, West 

The transition matrix (by rows) is defined as follows: 


Downtown East West 
Downtown 0. 3888889 0.3333333 0.2777778 
East 0. 3888889 0.3333333 0.2777778 
West 0.3888889 0.3333333 0.2777778 


该 方法 返回 一 个 马尔 可 夫 对 象 矩 阵 形式 的 固定 向 量 . 


> 70 * steadyStates (mcRental) 


结果 如 下 : 


Dowrntowrn East West 
[1,] 27.22222 23.33333 19.44444 


输出 mcRental 的 概要 : 


> summary (mcRental) 


结果 如 下 : 


Rental cars Markov chain that is composed by: 
Closed classes: 

Downtown East West 

Recurrent classes: 

iDowntown,East,West] 

Transient classes: 

NONE 

The Markov chain is irreducible 

The absorbing states are: NONE 


在 给 定 当前 状态 的 情况 下 ， 提 取 后 续 状 态 的 条 件 分 布 ，mcRental 为 输入 的 马尔 可 夫 链 对 象 ，"Downtown "是 下 一 个 状态 : 


> conditionalDistribution(mcRental, "Downtown") 
结果 如 下 : 
Downtown East West 

0.3 0.3 0.4 


» conditionalDistribution(mcRental, "West") 


结果 如 下 : 
Downtown East West 
0.2 0. 3 O. 2 
> conditionalDistribution(mcRental, "East") 
结果 如 下 : 
Downtown East West 
0.4 0.4 O. 2 


85 ”连续 马尔 可 夫 链 : 加 油 站 的 后 辆 服务 


一 个 加 油 站 有 一 个 单一 的 加 油泵 ， 没 有 车 辆 的 等 待 空间 。 如 果 车 辆 到 达 加 油泵 目 没有 空位 ， 车 辆 不 加 油 离开 。 车 辆 到 达 加 油 
站 服从 泊 松 过 程 ， 速 度 为 每 分 钟 3/20 辆 。 在 到 达 加 油泵 的 车 辆 中 ，75% 是 汽车 ，25% 是 摩托 车 。 加 油 时 间 可 以 用 指数 随机 变量 


建 模 ， 汽 车 平均 为 8 分 钟 ， 摩 托 车 为 3 分 钟 。 


准备 工作 


我 们 使 用 模拟 数据 来 搭建 加 油 站 车 辆 服务 的 连续 马尔 可 夫 链 。 


以 下 为 实现 细 市 。 
第 1 步 : 准备 数据 集 
首先 需要 加 载 以 下 软件 包 : 


install.packages ("simmer") 
install.packages("ggplot2") 
library (simmer) 
library (ggplot2) 


V V V V 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.2.2 (2015-08-14) 。 


初始 化 车 辆 到 达 率 : 


> ArrivalRate «- 3/20 


输出 数据 框 ArrivalRate: 


> ArrivalRate 


结果 如 下 : 


[1] 0.15 


初始 化 车 辆 服务 率 并 创建 数据 样本 。 使 用 函数 c () 组 合 参数 以 形成 向 量 。 传 递 给 函数 的 所 有 参数 都 将 被 组 合成 一 个 通用 类 
型 ， 即 返回 值 的 类 型 。 数 据 保存 在 数据 框 ServiceRate 中 : 


> ServiceRate «- c(1/8, 1/3) 


输出 数据 框 ServiceRate: 


> ServiceRate 
结果 如 下 : 
[1] 0.1250000 0.3333333 


急 始 化 汽车 到 达 概 率 : 


> p < 0.75 


CEFIRE., BEEmatrix () 使 用 给 定 的 值 的 集合 创建 中 阵 ， 结 果 保 仓 在 数据 框 TransitionMatrix 中 : 


> TransitionMatrix <- matrix(c(1, 
1, —ArrivalRate, 
1, ServiceRate[2], 


ServiceRate[1], 0, 
(1-p)*ArrivalRate, 


-ServiceRate[2]), byrow-T, ncol-3) 
输出 数 气 框 TransitionM atrix : 


> TransitionMatrix 


结果 如 下 : 


[.1] [.2] [.3] 
[1,] 1 0.1250000 0.0000000 
rA 1 -0.1500000 0.0375000 
[3,] 1 0.3333333 -0.3333333 


S588 IH: 
> B <- c(1, ο, 0) 
第 2 步 : 计算 理论 决策 


求解 线性 方程 组 。 使 用 函数 solve () 计算 线性 方程 ，t (A) 代表 转换 矩阵 ，B 为 向 量 ， 结 果 保 存在 P 中 : 


> P <— solve(t(A), B) 


输出 数据 框 P: 


> P 
结果 如 下 : 


[1] 0.44720497 0.49689441 0.05590062 


IAHR. BEENsum () 计算 求 和 ， 结 果 保 人 存在 Resolution 中 : 


> Resolution <- sum(P * c(1, 0, 1)) 


输出 数据 框 Resolution : 


> Resolution 


结果 如 下 : 


[1] 0. 5031056 


第 3 步 : 验证 理论 决策 的 收敛 性 
模拟 系统 并 验证 其 收敛 至 理论 决策 : 
> set .seed (1234) 


xEM.ERZXOption.1, &EZXcreate trajectory () 创建 汽车 和 摩托 车 类 型 的 轨迹 对 象 ， 这些 对 象 包括 要 连接 到 生成 器 对 象 的 一 
系列 活动 。 执 行 按 名 称 检 取 加 油条 的 活动 ， amount= 1 表示 需要 被 占用 的 对 象 的 数量 ， 背 数 timeout () 根据 用 户 定 义 插 入 延 
迟 ， 并 接收 函数 rexp () 函数 随机 生成 的 指数 分 布 ， 其 速率 定义 为 : 对 象 car 为 ServiceRate[1]=1/8， 对 象 motorcycle 为 
ServiceRate[1]=1/3, 


如 下 创建 模拟 对 象 。 方 法 初始 化 模拟 环境 。 对 象 car 和 motorcycle 服 从 指数 分 布 ， 比 率 定义 为 p*ArrivalRate， 其 中 
ArrivalRate=0.15。 在 模拟 环境 中 创建 一 个 新 的 到 达 生 成 器 : 


> option.1 «- function(t) ( 
car <- create trajectory() $»$ 
seize("pump", amount-1) $»$ 
timeout(function() rexp(1, ServiceRate[1])) $»$ 
release("pump", amount-1) 


motorcycle <- create trajectory() $»$ 
seize("pump", amount-1) $»$ 
timeout(function() rexp(1, ServiceRate[2])) $»$ 
release("pump", amount-1) 


simmer() %>% 
add resource("pump", capacity-1, queue size-0) $»$ 
add generator("car", car, function() rexp(1, p*ArrivalRate)) $»$ 
add generator("motorcycle", motorcycle, function() rexp(1, (1- 
p)*ArrivalRate)) $»$ 
run(until-t) 


) 


定义 函数 option.2。 为 各 种 车 辆 定义 单个 生成 器 和 单个 轨迹 。 为 了 区 分 汽车 和 摩托 后 ， 在 抓 取 资源 后 定义 一 个 分 又 ， 选 择 正 
确 的 服务 时 间 。 


国 数 create trajectory () 创建 汽车 和 摩托 车 类 型 的 轨迹 对 象 ， 这 些 对 象 包括 要 连接 到 生成 器 对 象 的 一 系列 活动 。 执 行 按 名 
称 检 取 加 油泵 的 活动 ,amount=1 表 示 需 要 逢 占用 的 对 象 的 数量 ， 上 数 timeout () 根据 用 户 定义 插入 延迟 ， 并 接收 遂 数 
rexp () 函数 随机 生成 的 指数 分 布 ， 其 速率 定义 为 : 对 象 car 为 ServiceRate[1]=1/8， 对 象 motorcycle 为 ServiceRate[1]= 1/3, 


接着 创建 模拟 对 象 。 方 法 初始 化 模拟 环境 。 对 象 car 和 motorcycle 服 从 指数 分 布 ， 比 率 定义 为 p*ArrivalRate， 其 中 
ArrivalRatez0.15, gZyrun () 继续 运行 ， 直 到 用 户 定义 超时 ， 如 until=t 所 述 : 


> option.2 «- function(t) { 
vehicle <- create trajectory() $»$ 
seize("pump", amount-1) $»$ 
branch(function() sample(c(1, 2), 1, prob-c(p, 1-p)), merge=c (T, 
T), 
create trajectory("car") $»$ 
timeout(function() rexp(1, ServiceRate[1])), 
create trajectory("motorcycle") %>% 
timeout(function() rexp(1, ServiceRate[2]))) %>% 
release("pump", amount-1) 


simmer() %>% 
add resource("pump", capacity-1, queue size-0) $»$ 
add generator("vehicle", vehicle, function() rexp(1, 
ArrivalRate)) $»$ 
run(until-t) 


-- 


AES BEOption.3, ορίίοη.218ΗΠ ΓΙΟΞΕΗΗΖΤΕΗ. AFNA, [ΕΒΕ FBë, Euzerës2ytimeout () 
内 选择 服务 时 间 : 


> option.3 «- function(t) { 
vehicle <- create trajectory() %>% 
seize("pump", amount-1) $»$ 
timeout(function() ( 
if (runif(1) « p) rexp(1, ServiceRate[1]) 
else rexp(1, ServiceRate[2]) 
y) %>% 
release ("pump", amount=1) 


simmer() %>% 

add resource("pump", capacity-1, queue_size=0) %>% 

add generator("vehicle", vehicle, function() rexp(1, ArrivalRate)) $»$ 
run(until-t) 


) 


an FUSFIeli&BRoptionggzk : 
> gas.station «- option.3(5000) 


第 4 步 : 绘制 结果 


绘制 结果 。 使 用 函数 plot resource usage () 绘制 在 仿真 时 间 范 围 内 的 资源 使 用 情况 ，gas.station 代 表 一 个 单一 的 环 
iS, "Pump "代表 资源 名 称 ，items= "system "代表 要 绘制 的 资源 组 件 ， 结 果 保 人 存在 ggplot2 类 型 图 像 中 : 


> graph <- plot resource usage(gas.station, "pump", items-"system") 
> graph + geom hline(yintercept = Resolution) 


结果 如 下 : 


pump 资源 使 用 情况 
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86 “蒙特 卡 罗 模拟 : 校准 Hull-White 短 期 利率 


蒙特 卡 罗 模 拟 是 系统 行为 的 随机 模拟 ， 对 模型 进行 抽样 实验 ， 然 后 使 用 计算 机 进行 数值 实验 ， 以 获得 对 系统 行为 的 统计 学 理 


cum 
+q 
° 


准备 工作 


为 了 搭建 校准 Hull-White 短 期 利率 的 蒙特 卡 洛 模拟 ， 数 据 取 自 QuantLib 0.3.10 的 样本 代码 ， 市 场 数据 用 于 构建 具有 相应 期 
限 的 利率 和 交换 波动 率 和 矩阵 的 期 限 结构 。 


第 1 步 : 安 疼 软件 包 和 库 
首先 加 载 以 下 软件 包 : 


>install.packages ("RQOuantLib", type-"binary") 
>install.packages ("ESGtoolkit") 

>library (RQuantLib) 

>library (ESGtoolkit) 


版 本 信息 : 代码 测试 的 RR 语言 版 本 为 3.2.2 (2015-08-14) 。 


为 了 使 部 分 QuantLib 软 件 包 在 R 环 境 下 使 用 ， 选 择 RQuantLib 包 。QuantLib 软 件 包 为 量化 金融 提供 了 一 个 全 面 的 软件 框 
淋 。RQuantLib 的 目标 是 为 金融 资产 的 建 模 、 交 易 、 定 量 分 析 和 风险 管理 提供 资源 库 。 


type="binary" 表 示 需 要 下 载 和 安 沪 的 软件 包 类 型 ， 这 代表 即将 被 安装 的 软件 包 不 是 资源 包 ，。 


具体 实施 步骤 


以 下 为 实现 细 市 。 
第 2 步 : 初始 化 数据 和 变量 
急 始 化 变量 : 


> freq «- "monthly" 
» delta t «- 1/12 


输出 delta t 的 值 : 


> delta t 


结果 如 下 : 


[1] 0. 08333333 


从 集成 QuantLib 0.3.10 的 抽样 代码 初始 化 变量 。 列 表 指 定 tradeDate (月 /日 /年 ) 、settleDate、 远 期 速率 时 间 段 dt 和 两 个 
曲线 构造 选项 : interpWhat (可 能 的 值 贴现 、 远 期 和 零 ) 和 interpHow (可 能 的 值 为 线性 、 对 数 线性 和 样 条 ) 。 这 里 的 spline 


表示 interpWhat 值 的 三 次 样 条 插值 。 


结果 保存 在 数据 框 params 中 : 


> params <- list (tradeDate=as .Date('2002-2-15'), 
settleDate-as.Date('2002-2-19'), 
payFixed-TRUE, 


dt-zdelta t, 
strike-.06, 


method-"HWAnalytic", 
interpWhat-"zero", 
interpHow- "spline") 


急 始 化 市 场 数据 。 为 利率 、 和 存款 和 挥 期 构建 期 限 结构 ， 结 果 保存 在 TermQuotes 中 : 


> TermQuotes <- list(dlw =0.0382, ἡ 1-week deposit rate 
—0.0372,4 1-month deposit rate 


dim 
d3m 
dém 
d9m 
dly 
s2y 
s3y 
s5y 


sl0y 
sl5y 


初始 化 SwaptionMaturities: 


O O OO: o 


.0363,# 3-month deposit rate 
.0353,# 6-month deposit rate 
.0348,# 9-month deposit rate 
.0345,# 1-year deposit rate 
.037125,14 2-year swap rate 


Ξ0.0398,84 3-year swap rate 
=0.0443,# 5-year swap rate 


=0.05165,# 10-year swap rate 
Ξ0.055175) { 15-year swap rate 


> SwaptionMaturities <- c(1,2,3,4,5) 


输出 SwaptionMaturities 的 值 : 


> SwaptionMaturities 


结果 如 下 : 


[1]1234 5 


初始 化 SwapTenors: 


> SwapTenors <- c(1,2,3,4,5) 


输出 SwapTenors 的 值 : 


> SwapTenors 


结果 如 下 : 


[1] 1234 5 


ΒΗ GUERRE. BRÉXmatrix () RAEE RALE, now- RATA, byrow=TRUER REIT 


填充 ， 结 果 保 存在 VolatilityMatrix 中 : 


- 


> VolatilityMatrix <- matrix ( 
c(0.1490, 0.1340, 0.1228, 0.1189, 0.1148, 


0.1290, 0,1201, 0.21146, 0.1108, 0.1040, 

0.1149, 0-1112; 0:1070; 0-1010, 0.0957, 

0.1047, 0.1021, 0.0980, 0.0951, 0.1270, 

0.1000, 0.0950, 0.0900, 0.1230, 0.1160), 
ncol=5, byrow=TRUE) 


第 3 步 : 定价 Bermudan 互 换 期 权 


如 下 定价 Bermudan 互 换 期 权 。BermudanSswaption 为 QuantLib 软 件 包 的 一 部 分 ， 使 用 RQuantLib 软 件 包 来 访问 R 环 境 。 
在 将 选 定 的 短期 利率 模型 校准 为 输入 互 换 期 权 波 动 率 和 矩阵 之 后 ，BermudanSwaption 使 用 指定 的 实施 价格 和 到 期 日 〈 几 年 内 ) 
定价 Bermudan 互 换 期 权 。 互 换 期 限 和 掉 期 期 限 是 多 年 的 。 假 设 Bermudan 互 换 期 权 可 以 在 每 个 重 置 日 期 的 潜在 掉 期 中 进行 。 计 
算 Bermudan 互 换 期 权 的 输入 参数 有 params、TermQuotes、SwaptionMaturities、SwapTenors 和 VolatilityMatrix: 


> BermudanSwaption «- RQuantLib::BermudanSwaption(params, TermQuotes, 
SwaptionMaturities, SwapTenors, VolatilityMatrix) 


显示 BermudanSwaption 的 值 ， 结 果 如 下 : 


Hull-white (analytic) calibration 

OxO: model 0.106204, market 0.114800, diff -0.008596 
OxO: model 0.106296, market 0.110800, diff -0.004504 
0x0: model 0.106341, market 0.107000, diff -0.000659 
OxO: model 0.106443, market 0.102100, diff 0.004343 

0x0: model 0.106613, market 0.100000, diff 0.006613 


输出 BermudanSwaption 的 概要 : 


> summary (BermudanSwaption) 


结果 如 下 : 


Summary of pricing results for Bermudan Swaption 
Price (in bp) of Bermudan swaption is  24.92137 
Stike is NULL (ATM strike is 0.05 ) 
Model used is: Hull-white using analytic formulas 
Calibrated model parameters are: 


a= 0.04641 
Sigma = 0.005869 


输出 BermudanSwaption 的 值 : 


> BermudanSwaption 


结果 如 下 : 


$a 
[1] 0.04641377 


$sigma 
[1] 0.005869286 


$price 


[1] 24.92137 


$ATMStrike 
[1] 0.05000001 


attr(," class") 
[1] "HwAnalytic" "Bermudans5wapt ion" 


第 4 步 : 构建 利率 的 现货 期 限 结构 
切 始 化 由 贴现 因子 、 远 期 汇率 和 零 率 组 成 的 时 间 向 量 。 时 间 补 指定 为 使 得 最 大 时 间 加 delta_t 不 超过 用 于 校准 工具 的 最 长 到 
期 时 间 (ANE) : 


> times «- seq(from = delta t, to = 5, by = delta t) 


DiscountCurve 根 据 输入 市 场 数据 (包括 结算 日 期 、 存 款 利率 和 掉 期 率 ) 构建 利率 的 现货 期 限 结构 ， 它 返回 指定 为 输入 的 时 
间 向 量 的 相应 贴现 因子 、 远 期 汇率 和 零 率 。Params 代 表 列 表 指 定 tradeDate (月 /日 /年 ) 、settleDate、 远 期 速率 时 间 段 和 两 个 
曲线 构造 选项 : interpWhat (可 能 的 值 贴现 、 远 期 和 零 ) 和 interpHow (可 能 的 值 为 线性 、 对 数 线性 和 样 条 ) 。 这 里 的 spline 


表示 interpWhat 值 的 三 次 样 条 插值 。TermQuotes 代 表 构 建 利率 现 贷 期 限 结构 的 市 场 报价 。 使 用 以 下 命令 : 


> DiscountCurve «- RQuantLib::DiscountCurve(params, TermQuotes, times) 


探索 数据 框 DiscountCurve 的 内 部 结构 。 使 用 为数 str () 探索 作为 R 对 象 的 数据 框 DiscountCurve 的 内 部 结构 : 


> str(DiscountCurve) 


结果 如 下 : 
List of 7 

$ times : num [1:60] 0.0833 0.1667 0.25 0.3333 0.4167 ... 
$ discounts : num [1:60] 0.997 0.994 0.991 0.988 0.985 ... 
$ forwards : num [1:60] 0.0365 0.0358 0.0349 0.0342 0.0338 ... 
$ zerorates : num [1:60] 0.0376 0.037 0.0366 0.0362 0.0358 ... 
$ flatQuotes: logi FALSE 
$ params :List of 8 


..$ tradeDate : Date[1:1], format: "2002-02-15" 
$ settleDate: Date[1:1], format: "2002-02-19" 


..$ payFixed : logi TRUE 
za Ht : num 0.0833 
..$ strike : num 0.06 
--$ method : chr "HwAnalytic" 
..$ interpwhat: chr "zero" 
..$ interpHow : chr "spline" 
$ table : data.frame': 183 obs. of 2 variables: 
..$ date : Date[1:183], format: "2002-02-19" "2002-03-20" "2002-04-22" "2002-05-22" ... 


..$ zeroRates: num [1:183] 0.0387 0.0376 0.037 0.0366 0.0362 ... 
- attr(*, "class")- chr "Discountcurve" 


查找 返回 贴现 因子 、 远 期 汇率 和 零 率 的 到 期 时 间 : 


> maturities <- DiscountCurve$times 


输出 maturities 的 值 : 


> maturities 


结果 如 下 : 


[1] 0.08333333 0.16666667 0.25000000 0.33333333 0.41666667 0.50000000 0.58333333 0.66666667 ο. 75000000 0. 83333333 
ΤΙ ο ους 1. 0833434333 1.16666667 1. 25000000 1. 33333333 1.41666667 1.50000000 1. 2383433333 1.66666667 1.75000000 
ο... 2.00000000 2.08333333 2.16666667 2.25000000 2. 33333333 2.41666667 2.50000000 2.58333333 2. 00066667 
id 281133351 2.91666667 3.00000000 3.08333333 3.16666667 3.25000000 3.33333333 3.41666667 3.50000000 3.58333333 
ποῦ 3. 83333333 3.91666667 4.00000000 4. 0834343333 4.16666667 4. 23000000 4.33333333 4.41666667 4. 50000000 
t e. ctm 4.75000000 4.83333333 4.91666667 5.00000000 


查找 零 息 票 率 : 


> MarketZeroRates <- DiscountCurveS$zerorates 


> MarketZeroRates 


结果 如 下 : 


[1] 0. 03760349 0.03704203 0.03662016 0.03618554 0.03578598 0.03546280 0.03521342 0.03500431 0. 03482148 0.03462910 
0. 03445629 

[12] 0.03438130 0.03440817 0.03448436 0.03460322 0.03475813 0.03494245 0.03514953 0.03537275 0.03560546 0.03584102 
0. 03607281 

[23] 0.03629418 0. 03649850 0. 03669634 0. 03690156 0.03711288 0.03732899 Ο. 03754861 0.03777043 0.03799317 0.03821553 
0. 03843622 

[34] 0. 03865395 0. 03886741 0. 03907533 0. 03928021 0. 03948630 0. 03969335 0. 03990105 Ο. 04010912 0. 04031728 0. 04052524 
0. 04073270 

[45] 0Ο. 04093939 Ο. 04114501 Ο. 04134928 Ο. 0415351091 0. 04173261 Ο. 04195110 0. 04214709 Ο. 04234029 Ο. 04253041 Ο. 04271717 
0. 04290028 

[56] 0.04307945 0. 04325440 Ο. 04342484 0.04359047 Ο. 04375102 


查找 贴现 因子 : 


> MarketPrices «- DiscountCurveSdiscounts 


输出 贴现 因子 : 


> MarketPrices 


结果 如 下 : 


[1] 0.9968713 0.9938453 0.9908867 0.9880106 0.9851998 0.9824249 0.9796684 0.9769340 0.9742220 0.9715548 0.9689087 
teg v 0.9605668 0.9576681 0.9547133 0.9517034 0.9486415 0.9455327 0.9423840 0.9392047 0.9360059 0.9328006 
251.9, 9,6396 0.9231594 0.9198874 0.9165845 0.9132529 0.9098950 0.9065138 0.9031126 0.8996949 0.8962647 0.8928262 
ο”. 0. 8824616 0.8/89710 0. 8754620 0.8/19338 0. 86083934 0. 8048360 0. 8612648 0. 8576813 0. 8540867 0.8504826 
[43] 0.8432517 0.8396281 0.8360013 0. 8323730 0.828/451 0.8251193 0.8214976 0.8178818 0.8142740 0.8106761 0.8070902 


第 5 步 : 模拟 Hull-White 短 期 利率 


> horizon <- 5 


设置 模拟 数 : 


> NoSimulations «- 10000 
> a «- BermudanSwaption$a 


输出 a 的 值 : 


> a 


[1] 0.04641377 


> sigma «- BermudanSwaption$sigma 


输出 Sigma 的 值 : 


> sigma 


[1] 0.005869286 


模拟 高 斯 中 击 。 消 数 simshocks () 为 风险 因素 创建 模拟 的 相关 高 斯 冲击。n=NoSimulations 代 表 模 拟 数 ，horizon=5 代 


表 投 资 期 ， 结 果 保 存在 数据 框 GaussianShocks 中 : 


> GaussianShocks «- ESGtoolkit::simshocks(n = NoSimulations, horizon = 
horizon, frequency = freq) 


E simdiff () 进行 扩散 过 程 的 模拟 。n=NoSimulations 表 示 独 立 观 察 次 数 ，frequency=freq 代 表 频 率 按 月 进 
fj, model="OU "代表 Ornstein-Uhlenbeck 方 法 ，x0= 0 为 过 程 的 起 始 值 ，eps=GaussianShocks 代 表 高 斯 冲击 : 


> x <- ESGtoolkit::simdiff(n = NoSimulations, horizon = horizon, 
frequency = freq, model = "OU", x0 = 0, thetal = 0, theta2 = a, theta3 = 
sigma, eps - GaussianShocks) 


ΥΓ ΣΟΗΗΙ 2, BQZXts () 创建 时 间 序 列 对 象 ，replicate (nb.sims, DiscountCurve$forwards) 创建 时 间 序 列 值 的 向 
量 ，start=start (x) 代表 第 一 次 观察 的 时 间 ，deltat=deltat (x) 代表 连续 观察 之 间 的 采样 周期 的 分 数 ， 结 果 保 存在 数据 框 
ForwardRates 中 : 


> ForwardRates <- ts(replicate(nb.sims, DiscountCurveS$forwards), start 
= start(x), deltat = deltat (x)) 


生成 常规 序列 。from=0，to=horizon 代 表 序 列 的 起 始 值 和 结束 值 ，by=delta_t 代 表 序 列 增 量 : 


> 七 .out <- seq(from = 0, to = horizon, by = delta t) 

> param.alpha <- ts(replicate(NoSimulations, O0.5*(sigma^2)*(1 - exp(- 
a*t.out))^2/(a^2)), start = start(x), deltat = deltat (x)) 

> alpha «- ForwardRates + param.alpha 


生成 短期 利率 : 


> ShortRates <- x + alpha 


计算 随机 贴现 值 。r=ShortRates 表 示 短 期 利率 ，X=1 表 示 资 产 的 价格 : 
> StochasticDiscount «- ESGtoolkit::esgdiscountfactor(r = ShortRates, X 
= 1) 
计算 随机 贴现 值 的 均值 : 
> MonteCarloPrices «- rowMeans (StochasticDiscount) 


输出 MonteCarloPrices 的 值 : 


> MonteCarloPrices 


结果 如 下 : 


[1] 0. 9969646 Ο. 9939972 0.9911117 0. 9882912 0. 9855078 0. 9827449 0. 9800036 0. 9772856 0. 9746132 0. 9719634 0. 9692537 


0. 9664558 
[13] ο. 9636063 0.9607016 0.9577400 0. 9547254 0.9516572 0. 9485439 Ο. 94534012 0. 9422074 0. 9390047 0.9357938 0. 9325805 
ο. 9293760 
[25] 0. 92613412 0. 9228538 0.9195472 0.9162110 0.9128457 0. 9094549 0.9060440 ο. 9026178 0. 8991/89 0. 8957324 0. 8922809 
0. 8888213 
[37] 0.8853405 0.8818385 0.8783182 0.8747819 0.8712305 0.8676639 0.8640836 0.8604893 0.8568831 0.8532672 0.8496438 
0. 8460148 
[49] 0.8423810 0.8387448 0.8351062 0.8314680 0.8278328 0.8242010 0.8205761 0.8169591 0.8133518 0.8097557 0.8061732 
ο. 8025957 

计算 随机 贴现 值 的 零 率 : 

> MonteCarloZeroRates «- -log(MonteCarloPrices)/maturities 


输出 MonteCarloZeroRates 的 值 : 


> MonteCarloZeroRates 


结果 如 下 : 


[1] 0. 03648056 0.03612541 0.03571211 0.03533363 0.03503568 0.03481134 0.03462698 0.03446451 0.03428612 0.03412455 
[15] 0.034119/5 0.03422072 0.03436407 0.03454314 0.03474862 0.03497678 0.03521811 0.03546727 0.03571789 0.03596274 
TOY WT 0.03662097 0.03683488 0.03705436 0.03727730 0.03750368 0.03773315 0.03796394 0.03819385 0.03842104 
[341 0- 03855382 0.03907689 0.03928637 0.03949716 0.03970938 0.03992196 0.04013419 0.04034595 0.04055738 0.04076813 
[451 0-011008 0.04139545 0.04160121 0.04180462 0.04200561 0.04220371 0.04239914 0.04259133 0.04277979 0.04296464 
IS] dO 11155 0.04349296 0.04365987 0.04382170 0.04398085 


对 随机 贴现 条 件 和 市 场 价格 之 间 的 差异 进行 学 生 t 检 验 ，t.test (X) 执行 t 检 验 ，conf.int 代 表 适 当 的 置信 区 间 : 


> ConfidenceInterval <- t(apply((StochasticDiscount - MarketPrices)[-1, 
], 1, function(x) t.test (x)S$conf.int)) 


使 用 函数 head () 返回 数据 框 Confidencelnterval 的 头 部 数据 ，Confidencelnterval 作 为 函数 的 输入 参数 : 


> head(ConfidenceInterval) 


L.1] [.2] 
[1,] 0.0001491098 0.0001545721 
[2,] 0.0002189103 0.0002310291 


[3,] 0.0002704573 0.0002907584 
[4,] 0.0002932542 0.0003228398 
[5,] 0.0003000920 0.0003400166 
[6,] 0.0003095954 0.0003607932 


如 下 设置 图 像 参数 : 


> par(mfrow = c(2, 2)) 


国 数 esgplotbands () 绘制 色 带 置信 区 间 ，shortRates 代 表 置 信 区 间 : 


> ESGtoolkit::esgplotbands (ShortRates, xlab = "maturities", ylab = 
"short-rate quantiles", main - "Short Rate Quantiles") 


绘制 蒙特 卡 罗 市 场 零 率 ，maturities 和 MonteCarloZeroRates 代 表 时 间 序 列 : 
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在 maturities 和 MonteCarloZeroRates 之 间 图 的 指定 坐标 处 添加 点 序列 : 


> plot (maturities, MonteCarloZeroRates, type-'l', col = 'blue', lwd = 
1, main = "Monte Carlo v/s Market n Zero Rates") 


绘制 蒙特 卡 罗 市 场 价格 ，maturities 和 MonteCarloZeroRates 代 表 时 间 序 列 : 


Monte Carlo v/s Market n Zero Rates 


0.042 


MonteCarloZeroRates 
0.038 


0.034 


maturities 


在 maturities 和 MonteCarloZeroRates 之 间 图 的 指定 坐标 处 添加 点 序列 : 


> points (maturities, MonteCarloZeroRates, col = 'red') 
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绘制 蒙特 卡 罗 市 场 价格 ，maturities 和 MonteCarloZeroRates 代 表 时 间 序 列 : 


> plot (maturities, MonteCarloPrices, type='l', col = 'blue', lwd = 1, 
main = "Monte Carlo v/s Market Prices") 


Monte Carlo v/s Market n Zero-Coupon Prices 
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在 maturities 和 MonteCarloZeroRates 之 间 图 的 指定 坐标 处 添加 点 序列 : 


> points (maturities, MonteCarloPrices, col = 'red') 


Monte Carlo v/s Market n Zero-Coupon Prices 
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maturities 
> matplot(maturities[-1], conf.int, type = '1', main = "Confidence 


Interval for the price difference") 


5695: AFN 


本 章 将 涵盖 如 下 内 容 : 
隐 马 尔 可 夫 模 型 : 欧元 和 美元 


. 隐 蕊 尔 可 夫 模 型 : 区 制 检测 


隐 马 尔 可 夫 模 型 (HMM) 是 一 种 非常 强大 的 特征 化 离散 时 间 序 列 观 测 数据 样本 的 统计 万 法 。 它 不 仅 可 以 提供 建立 简约 参数 
模型 的 有 效 廊 法 ， 还 可 以 将 动态 规划 原理 纳入 其 核心 ， 用 于 时 变数 据 序列 的 统一 模式 分 割 和 模式 分 类 。 时 间 序 列 中 的 数据 样本 既 
可 以 离散 或 连续 分 布 ， 也 可 以 是 标量 或 向 量 。HMM 的 基本 假设 是 数据 样本 可 以 被 很 好 地 表征 为 参数 随机 过 程 ， 并 且 可 以 在 精确 
和 明确 定义 的 框架 中 估计 随机 过 程 的 参数 。 


92 BRETAR: 欧元 和 美元 


欧元 /美元 是 外 汇市 场 中 最 冲 见 的 交易 对 ， 这 是 因为 两 种 货币 代表 了 世界 上 最 大 的 两 个 经 济 体 、 贸 易 区 块 和 许多 在 大 西洋 进 
行业 务 的 跨国 公司 。 


这 种 贷 币 对 的 价格 变动 通常 与 影响 欧元 或 美元 价值 的 因素 有 关 。 作 为 世界 上 流动 性 最 强 的 货币 对 ， 稳 定性 和 波动 性 的 结合 
得 欧元 /美元 成 为 最 适合 初学 者 和 高 级 交易 员 的 交易 对 。 欧 元 /美元 对 为 交易 者 提供 高 流动 性 ， 并 具有 非常 紧张 和 有 竞争 力 的 利 
日 


党 新 闻 报道 的 美国 经 济 和 欧洲 经 济 的 相对 实力 通 弟 会 影响 这 一 交易 对 。 


准备 工作 
我 们 使 用 欧元 美元 数据 集 搭建 隐 马 尔 可 夫 模 型 ， 用 于 查找 不 同 的 市 场 区 制 并 以 此 最 优化 交易 策略 。 
第 1 步 : 收集 和 摘 述 数据 


选用 的 数据 集 EURUSD1d.csv 是 一 种 可 访问 的 CSV 格 式 标 准 数据 集 ， 人 存储 1008 行 数据 和 5 个 变量 ， 其 中 数值 型 变量 包括 : 


"pen 

: High 

: Low 

: Close 

非 数 值 型 变量 包括 : 


: Open Timestamp 


以 下 为 实现 细节 。 


第 2 步 : 探索 数据 


首先 需要 加 载 以 下 软件 包 : 


install.packages ("depmixS4") 
install.packages ("quantmod") 
install.packages("ggplot2") 
library (depmixS4) 
library (quantmod) 
library (ggplot2) 


V V V V V V 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.2.2 (2015-08-14) « 
现在 开始 探索 数据 并 理解 参数 之 间 的 关系 。 


我 们 导入 EURUSD1d.csv 数 据 集 ， 并 保存 为 数据 框 EyroUSD': 


> EuroUSD <- read.csv("d: /EURUSD1d.csv", header = TRUE) 


输出 EuroUsD 数 据 框 。 使 用 函数 head () 返回 EuroUSD 数 据 框 的 头 部 数据 ，EuroUSD 作 为 溺 数 的 输入 参数 : 


使 


> head (EuroUSD) 


结果 如 下 : 


head(EuroUSD) 


Open. Timestamp Open High LOW 


2 2012.01.04 00:00:00 1.30528 1.30718 1. 
3 2012.01.05 00:00:00 1.29295 1.29427 1. 
4 2012.01.06 00:00:00 1.27905 1.28116 1. 
5 2012.01.08 00:00:00 1.27136 1.27136 1. 
6 2012.01.09 00:00:00 1.26778 1.27843 1. 


一 个 多 


输出 EuroUSD 数 据 框 的 概要 。summary () 为数 是 一 个 多 


EuroUsD 数 据 框 为 ummary () 遂 数 的 输入 参数 : 


> summary (EuroUSD) 


close 


2012.01.03 00:00:00 1.29357 1.30760 1.29343 1.30528 


28967 1.29295 
27688 1. 27905 
26961 1.27136 
26649 1.26778 
26/62 1.27712 


ΒΗΙΦΙΒΗΗΡΕ ΕΝ, PEI XIERBOSURTETRABUASUIS ΞΕ. 


结果 如 下 : 
open. Timestamp open High LOW Close 

2012.01.03 00:00:00: 1 Min. :1.048 Min. :1.050 Min. :1.046 Min. :1. 048 
2012.01.04 00:00:00 1 lst οι. «1.272 lst Qu.:1.277 lst Qu.:1.267 lst οι. «1.272 
2012.01.05 00:00:00: 1 Median :1.311 Median :1.316 3 Median :1.306 | Median :1.311 
2012.01.06 00:00:00: 1 Mean :1. 300 Mean :1. 304 Mean :1. 296 Mean :1. 300 
2012.01.08 00:00:00: 1 3rd Qu. :1. 349 3rd Qu. :1.353 3rd Qu. :1.346 3rd Qu. :1.349 
2012.01.09 00:00:00 1 Max. :1.393 Max. :1. 399 Max. :1. 391 Max. :1. 393 
(Other) 1002 


探索 EuroUSD 数 据 框 的 内 部 结构 。 使 用 立 数 str () 探索 作为 R 对 象 的 EuroUSD 数 据 框 的 内 部 结构 : 


> str(EuroUSD) 


结果 如 下 : 


1008 obs. of 5 variables: 
Factor w/ 1008 levels "2012.01.03 


"data.frame': 
$ Open.Timestamp 


$ Open : mm 1.29 1.31 1.29 1.28 1.27 ... 
$ High : num 1.31 1.31 1.29 1.28 1.77 ... 
$ Low : num 1.29 1.29 1.28 1.77 1.27 ... 
$ close : num 1.31 1.29 1.28 1.27 1.27 ... 


第 3 步 : 将 数据 转换 为 时 间 序 列 


创建 字符 类 型 对 象 。 尔 数 as.character () 表示 15 位 有 效 数字 的 实数 和 复数 。 从 第 1 


> Date «- as.character(EuroUSD[,1]) 


00:00:007,..: 1234 5678910... 


FEN 


数 气 框 EuroUSD 分 开 : 


操作 数据 框 Date 以 表示 日 历 日 期 ， 然 后 将 结果 存储 在 数据 框 DateTimeSeries 中 : 


> DateTimeSeries <- as.POSIXIlt (Date, 


format = "$Y.$m.$d $H:$M:£S") 


eZ uHesHmNE, ERZXdata.frame () 为 EuroUSD[，2: 5] 创 建 数据 框 ，row.names=DateTimeSeries 为 创建 的 数据 


> TimeSeriesData <- data.frame(EuroUSD[,2:5], row.names = 


DateTimeSeries) 


输出 TimeSeriesData 数 据 框 。 使 用 国 数 head () 返回 TimeSeriesData 数 据 框 的 头 部 数据 ，TimeSeriesData 作 为 函数 的 输 
入 参数 : 


> head(TimeSeriesData) 


结果 如 下 : 

Open High Low Close 
2012-01-03 1.29357 1.30760 1.29343 1.30528 
2012-01-04 1.30528 1.30718 1.28967 1.29295 
2012-01-05 1.29295 1.29427 1.27688 1.27905 
2012-01-06 1.27905 1.28116 1.26961 1.27136 
2012-01-08 1.27136 1.27136 1.26649 1.26778 
2012-01-09 1.26778 1.27843 1.26762 1.27712 


EZXas.xts () 将 TimesSeriesData 数 据 对 象 转 损 为 xts 类 ， 而 不 会 丢失 任何 属性 ， 如 下 所 示 : 


> TimeSeriesData <- as.xts(TimeSeriesData) 


测量 最 高 价 一 最 低 价 一 收盘 价 序列 的 波动 性 。 阔 数 ATR () 测量 了 TimeSeriesData 中 最 高 价 一 最 低 价 一 收盘 价 序列 的 平均 
波动 率 。TimeSeriesData[，2: 省 表示 TimeSeriesData 的 最 高 价 一 最 低 价 一 收盘 价 序 列 ， 结 果 和 存储 在 数据 框 ATRindicator 中 : 


> ATRindicator <- ATR(TimeSeriesData[,2:4],n-14) 


输出 ATRindicator 数 据 框 : 使 用 函数 head () 返回 ATRindicator 数 据 框 的 头 部 数据 ，ATRindicator 作 为 函数 的 输入 参数 : 


> head(ATRindicator) 


结果 如 下 : 

tr atr trueHigh trueLow 
2012-01-03 ΝΑ NA ΝΑ NA 
2012-01-04 0.01751 NA 31.30718 1.28967 
2012-01-05 0.01739 NA 31.294?7 1.27688 
2012-01-06 0.01155 NA 1.28116 1.26961 
2012-01-08 0.00487 NA 1.27136 1.26649 
2012-01-09 0.01081 ΝΑ 1.27843 1. 26/62 


» TrueRange «- ATRindicator[,2] 


输出 数据 框 TrueRange: 


> head(TrueRange) 


结果 如 下 : 


Pu 


£ £ S S Š Š 5 


2012-01-03 
2012-01-04 
2012-01-05 
2012-01-06 
2012-01-08 
2012-01-09 


计算 收盘 价值 和 开盘 价值 的 对 数 返 回 值 的 差 值 ， 结 果 保 存在 数据 框 LogReturns 中 : 


> LogReturns <- log(EuroUSD$Close) - log(EuroUSDSOpen) 


输出 LogReturns 数 据 框 的 概要 。summary () 函数 是 一 个 多 用 途 通 用 函数 ， 提 供与 单个 对 象 或 数据 框 相关 的 数据 概要 。 
LogReturns 数 据 框 为 ummary () 函数 的 输入 参数 : 


> summary (LogReturns) 


结果 如 下 : 


Min. lst Qu. Mediar Mean 3rd Qu. Max. 
-2.335e-02 -2.34/e-03 -4.96/e-05 -1.779e-04 2.155e-03 2.624e-02 


第 4 步 : 构建 模型 
创建 HM M 模 型 的 数据 框 。 使 用 函数 data.frame () 创建 变量 的 紧密 耦合 的 数据 框 ， 这 些 变量 共享 矩 咋 的 属性 : 


> HMMModel «- data.frame(LogReturns, TrueRange) 


删除 为 HMMModel 计 算 指标 的 数据 : 


> HMMModel «- HMMModel[-c(1:14),] 


输出 数据 框 HMMModel: 


> head (HMMMode 1) 


结果 如 下 : 


LogReturrs atr 
2012-01-19 .0.0075360408 0.01244214 
2012-01-20 -0.002526336/ 0.01226342 
2012-01-22 -0.003238/061 0.01176603 
2012-01-23  0.0106681264 0.01213846 
2012-01-24  0.000//5208/ 0.01205285 
2012-01-25 40.0054554841 0.01254551 


HIREA. Kc () 用 于 将 参数 组 合成 同 量 。 传 递 给 函数 的 所 有 参数 都 将 被 组 合 形成 一 个 通用 类 型 ， 即 返回 值 的 类 


> colnames(HMMModel) <- c("LogReturns","TrueRange") 


输出 列 名 字 : 


> colnames (ΗΜΜΜοΟάΕΘ]Ι ) 


结果 如 下 : 


[1] "LogReturns" "TrueRange" 


» set.seed(1) 


ff — ^ — JANE, HESSA. BEgEXdepmix () 创建 隐 马 尔 可 夫 模 型 ，LogReturns ~ 1 和 TrueRange 
~ 1 表示 要 建 模 的 响应 。data=HMMModel 表 示 用 于 解释 变量 的 数据 框 ，nstates=3 表 示 状 态 数 : 
> HMM «- depmix(list(LogReturns-1, TrueRange-1), data = HMMModel, 
nstates-3, family-list(gaussian(), gaussian())) 


7JEXXE X. BURGI HMMTES, SERENE, žit () 最 优化 HMM 模 型 的 参数 ，HMM 代 表 类 对 
象 ，verbose=FALSE 表 示 不 显示 信息 ， 最 优化 参数 存储 在 类 depmix 中 的 对 象 HM Mfit: 


> HMMfit <- fit (HMM, verbose = FALSE) 
converged at iteration 29 with logLik: 9503.258 


对 比 AIC 和 BIC 值 的 对 数 似 然 ， 遂 数 print () 输出 HM MTfit 参 数 : 


> print (ΗΜΜΕΙΤ) 


结果 如 下 : 


Convergence info: Log likelihood converged to within tol. (relative change) 
"log Lik. ' 9503.258 (df-20) 

AIC:  -18966.52 

BIC: -18868.48 


> summary (HMMfit) 


输出 LogReturns 数 据 框 的 概要 。summary () 函数 是 一 个 多 用 途 通 用 函数 ， 提 供与 单个 对 象 或 数据 框 相关 的 数据 概要 。 
LogReturns 数 据 框 为 ummary () 函数 的 输入 参数 。 


结果 如 下 : 

state 51 52 53 
1 3 0.000000e+00 0.000000e+00 1 
2 3 3.024478e-110 4.676808e-20 1 
3 3 5.413285e-54 5.129597e-17 1 
4 3 5.597014e-60 3.165933e-20 1 
5 3 1.888606e-56 1.182525e-18 1 
6 3 3.550974e-61 4.009794e-2? 1 


为 每 个 数据 集 状态 找到 后 验 。 结 果 存 储 在 HMM state 中 : 


> HMMstate <- posterior (HMMfit) 


输出 数据 框 HMMstate， 显 示 每 个 状态 每 天 的 概率 和 最 高 概率 的 类 别 |: 


> head(HMMstate) 


结果 如 下 : 

state S1 52 53 
1 3 0.000000e400 0.000000e-00 1 
2 3 3.024478e-110 4.676808e-20 1 
3 3 5.413285e-54 5.129597e-17 1 
4 3 5.59/7014e-60 3.165933e-20 1 
5 3 1.888606e-56 1.182525e-18 1 
6 3 3.5509/4e-601 4.009794e-22 1 


按 以 下 3 个 步骤 显示 计算 得 到 的 数据 框 HM M state。 


创建 HM M 模 型 的 数据 框 。 基 于 紧密 耦合 的 变量 集 ， 使 用 函数 data.frame () 创建 数据 框 。 这 些 变量 共享 距 阵 的 属性 。 作 为 


参数 传递 给 data.frame () 的 数据 框 有 DateTimeSeries、LogReturns 和 TrueRange。 结 果 存 储 在 数据 框 DFIndicators 中 : 


> DFIndicators «- data.frame(DateTimeSeries, LogReturns, TrueRange) 
» DFIndicatorsClean «- DFIndicators[-c(1:14), ] 


如 下 创建 数据 框 : 


> PlotlData <- data.frame(DFIndicatorsClean, HMMstateS$state) 


使 用 ggplot () 绘制 结果 : 


> LogReturnsPlot <- 
ggplot (PlotliData,aes(x-PlotliData[,1],y-PlotliData[,2]))-*geom line(color-"dar 
kred")-Tlabs(,y-2"Log Return Values", x="Date") 

» LogReturnsPlot 


结果 如 下 : 


欧元 美元 日 对 数 回报 


对 数 回 报 值 


2012-01 2012-07 2013-01 2013-07 2014-01 2014-07 2015-01 


日 期 


9.3 Ban haz: 区 制 检测 


标准 普尔 500 指 数 (Standard&Poor s 500Index, S&P 500) 是 美国 股市 500 指 数 。 它 是 美国 股票 的 领先 指标 ， 反 映 了 经 
济 学 家 选择 的 大 盘 公 司 的 表现 。 专 家 在 确定 500 股 时 ， 考 虑 到 的 因素 包括 市 场 规模 、 流 动 性 和 产业 分 组 。 这 是 一 个 市 场 价 值 加 权 
指数 ， 也 是 美国 股票 市 场 的 共同 基准 之 一 。 基 于 标准 普尔 500 指 数 的 投资 产品 包括 指数 基金 和 交易 所 交易 基金 可 供 投 资 者 使 用 。 
投资 者 对 标准 普尔 500 指 数 有 所 挑战 ， 因 为 投资 组 合 需要 500 家 公司 的 股票 与 整个 投资 组 合 的 比例 ， 以 复制 指数 的 市 值 方 法 。 对 
于 投资 者 来 说 ， 购 买 标准 普尔 500 指 数 之 一 的 投资 产品 更 简单 ， 如 Vanguard S&P 500ETF、SPDR S&P 500ETF 或 the Shares 
S&P 500Index ΕΤΕ. 


准备 工作 


我 们 使 用 S&P500 回 报 数 据 集 来 构建 隐 马 尔 可 夫 模 型 。 
第 1 步 : 收集 和 摘 述 数据 


数据 集 选 取 从 2004 年 1 月 1 日 起 至 今日 的 每 日 9&P500 回 报 值 。 我 们 将 要 下 载 的 数据 集 可 以 在 以 下 网 址 免费 获得 : 
http://yahoo.com, 


以 下 为 实现 细节 。 
第 2 步 : 探索 数据 


加 载 以 下 软件 包 : 


M 


> install.packages("depmixS4") 
> install.packages ("quantmod") 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.3.0 (2016-05-03) 。 
安 半 以 下 资源 库 : 


> library ("depmixS4") 
> library ("quantmod") 
» set.seed(1) 


现在 开始 标记 所 需 数 据 时 间 段 的 起 始 时 间 和 结束 时 间 ， 并 下 载 数 据 。 


使 用 函数 getsymbols () 加 载 数据 。 该 销 数 从 本 地 或 远程 的 多 个 源 加 载 数 据 。GSPC 为 字 待 向量， 指定 需要 加 载 的 符号 


- getSymbols( "^GSPC", fromz"2004-01-01" ) 


AS of 0.4-0, 'get5ymbols' uses env-parent.frame() and 
auto.assign-TRUE by default. 


This behavior will be phased out in 0.5-0 when the call will 
default to use auto.assign-FALSE. getoption(" getsymbols.env") and 
getOptions("getsymbols.auto.assign") are now checked for alternate defaults 


This message is shown once per session and may be disabled by setting 


options("gets5ymbols.warning4.0" —FALSE). See ?getsymbols for more details. 
[1] "GsPC" 


计算 所 有 收盘 价 之 间 的 对 数 差 值 ， 结 果 保存 在 数据 框 GSPCDiff 中 : 


> GSPCDiff = diff( log( Cl( GSPC ) ) ) 


探索 GQSPCDiff 数 据 框 的 内 部 结构 。 使 用 函数 str () 探索 作为 R 对 象 的 G3PCDiff 数 据 框 的 内 部 结构 : 


> str(GSPCDiff) 


结果 如 下 : 


An 'xts' object on 2004-01-02/2016-11-30 containing: 
Data: num [1:3252, 1] NA 0.01232 0.00129 0.00236 0.00495 ... 
- attr(*, "dimnames")-List of 2 
..$ : NULL 
..$ : chr "GsPC.Close" 
Indexed by objects of class: [Date] TZ: UTC 
xts Attributes: 
List of 2 
$ src : chr "yahoo" 
$ updated: POSIXcrt[1:1], format: "2016-12-01 23:38:20" 


输出 数据 框 GSPCDiff : 
> head(GSPCDiff) 


结果 如 下 : 


GSPC.Close 
2004-01-02 NA 
2004-01-05 0.012319151 
2004-01-06 0.001291313 
2004-01-07 0.002364367 
2004-01-08 0.004950824 
2004-01-09 -0.008927336 


创建 数据 框 GSPCDiff 的 数字 类 值 : 


> returns = as.numeric(GSPCDiff) 


绘制 数据 框 GSPCDiff: 


> plot (GSPCDiff) 


GSPCDiff 


0.10 


0.05 


0.00 


-0.05 





-0.10 


Jan 02 2004 Jul 01 2005 Jan 03 2007 Jul 01 2008 Jan 04 2010 Jul 01 2011 Jan 02 2013 Jul 01 2014 Jan 04 2016 


第 3 步 : 准备 模型 
使 用 二 状态 为 S&P 回报 拟 合 隐 马 尔 可 夫 模 型 。 创 建 二 状态 的 隐 马 尔 可 夫 模 型 。 


国 数 depmix () 创建 隐 马 尔 可 夫 模 型 ，returns ~ 1 表示 要 建 模 的 响应 。data=data.frame (returns=returns) 表示 用 于 解 
量 的 数据 框 ，nstates= 2 表示 状态 效 : 
> hmm2states «- depmix(returns ~ 1, family = gaussian(), nstates = 2, 


data-data.frame(returns-returns)) 
» hmm2states 


结果 如 下 : 


Initial state probabilties model 
pri pr?2 
0.5 0.5 


Transition matrix 
tosi το» 

fromsi 0.5 0.5 
froms2 0.5 0.5 
Response parameters 
Resp 1 : gaussian 

Rel.(Intercept) Rel.sd 
St1 0 1 
St2 0 1 
为 已 定义 的 数据 集 拟 合 HMM 模 型 。 受 到 线性 不 等 式 的 限制 ， 函 数 fit () 最 优化 HMM 模 型 的 参数 ，hmm2states 代 表 


HMM 类 对 象 ，verbose=FALSE 表 示 不 显示 信息 ， 最 优化 参数 存储 在 类 depmix 中 的 对 象 hmmfit2states: 


> hmmfit2states «- fit(hmm2states, verbose = FALSE) 


converged at iteration 37 with logLik: 10518.77 


对 比 AIC 和 BIC 值 的 对 数 似 然 : 


> hmmfit2states 


结果 如 下 : 


convergence info: Log likelihood converged to within tol. (relative change) 
"log Lik. ' 10518.77 (df-7) 

AIC: -21023.55 

BIC: -20980.95 


为 每 个 数据 集 状 态 找到 后 验 。 结 果 存 储 在 PosteriorProbs 中 : 
> PosteriorProbs «- posterior(hmmfit2states) 


ierHPosteriorProbsZAigfE, fsFBERZMhead () 返回 PosteriorProbs 数 据 框 的 头 部 数据 ，PosteriorProbs 作 为 国 数 的 输入 


Ww 
BE 


> head (PosteriorProbs) 


结果 如 下 : 


state 51 52 
0.000000000 1.0000000 
0. 007 586430 0.9924136 
ο. 002517719 0. 9974823 
0. 002560062 0. 9974339 
0. 002888478 0.9971115 
0. 005725764 0. 9942742 


σι un d$ Lu ka F 
NJ 52 pa NJ NJ Ρο 


绘制 二 状态 结果 。type= 呈 代表 绘制 类 型 为 线 : 


> plot (returns, type-'l', main-'Regime Detection', xlab-'No of 
Observations', ylab-'Returns') 


结果 如 下 : 


区 制 监 测 





0 500 1000 1500 2000 2500 3000 


观测 序 


qn 


绘制 数据 框 PosterionProbs 的 列 : 


> matplot(PosteriorProbs[,-1], type='1', main='Regime Posterior 
Probabilities', xlab-'No of Observations', ylab='Probability') 








结果 如 下 : 
区 制 后 验 概 率 
πο. erm "e — p ey ma W T : P ! TI í` P Tad: M pe ΠῚ 1 Ux κ ^i Ve ' 
2 — ΙΕ | DEB ΤΠ | | ΠΝ E 
) i ΤΙ: | | | ὶ 
T < | | | | 
> 1 I i BE | 
E Y H Y h "WE NE d 
PI RIE ΕΙ AN R μή ΠΠ. 
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绘制 三 状态 隐 马 尔 可 夫 模 型 : 


> hmm3states <- depmix(returns ~ 1, family = gaussian(), nstates = 3, 
data-data.frame(returns-returns)) 
> hmm3states 


结果 如 下 : 


Initial state probabilties model 
pri pr2 pr3 
0.333 0.3343 0.333 


Transition matrix 

tosl το το” 
fromsi 0.333 0.333 0.333 
froms2 0.333 0.333 0.333 
froms3 0.333 0.333 0.333 


Response parameters 

Resp 1 : gaussian 
Rel.(Intercept) Rel.sd 

st1 0 1 

St2 0 1 

5t3 0 g: 


为 已 定义 的 数据 集 拟 合 HMM 模 型 : 


> hmmfit3states «- fit(hmm3states, verbose = FALSE) 
converged at iteration 102 with logLik: 10659.7 


为 每 个 数据 集 状态 找到 后 验 - 


> PosteriorProbs «- posterior (hmmfit3states) 


输出 数据 框 PosteriorProbs: 


> head(PosteriorProbs) 


结果 如 下 : 


state 51 52 53 
. 0000000 0.00000000 O.000000000 
. 9780159 0.01904906 0.002935031 
. 9196440 0.07/866273 0.001693291 
.8488129 0.14960389 0.001583215 
./605025 0.23/98856 0.001508972 
. 8433328 0.1546/220 0.001995043 


> plot (returns, type-'l', main-'Regime Detection', xlab-'No of 
Observations', ylab-z'Returns') 
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结果 如 下 : 
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> matplot(PosteriorProbs[,-1], type='l', main-z'Regime Posterior 
Probabilities', xlab-'No of Observations', ylab-'Probability') 





结果 如 下 : 
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创建 四 状态 隐 马 尔 可 夫 模 型 : 


> hmm4states «- depmix(returns ~ 1, family = gaussian(), nstates = 4, 
data-data.frame(returns-returns)) 
> hmmástates 


结果 如 下 : 


Initial state probabilties model 
pri pr2 pr3 pr4 
0.25 0.25 0.25 0.25 


Transition matrix 

tosi to52 τος” to54 
fromsi 0.25 0.25 0.25 0.25 
froms2 0.25 0.25 0.25 0.25 
froms3 0.25 0.25 0.25 0.25 
froms4 0.25 0.25 0.25 0.25 


Response parameters 
Resp 1 : gaussian 
Rel.(Intercept) Rel.sd 


oooo 
F: i: a la 


为 已 定义 的 数据 集 拟 合 HM M 模 型 


> hmmfit4ástates <- fit (hmm4states, verbose = FALSE) 
converged at iteration 426 with logLik: 10684.96 


为 每 个 数据 集 状 人 态 找到 后 验 : 


> PosteriorProbs «- posterior (hmmfit4states) 
» plot(returns, type-'l', main-'Regime Detection', xlab-'No of 
Observations', ylab-'Returns') 


结果 如 下 : 


区 制 监测 


0,16 
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> matplot(PosteriorProbs[,-1], typez2'l', main-'Regime Posterior 
Probabilities', xlab-'No of Observations', ylab-'Probability') 


结果 如 下 : 
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第 10 草 ”和 仲 经 网 络 


本 章 将 涵盖 如 下 内 容 : 
为 S&P 500 建 模 


. 测量 失业 率 


10.1 引言 


镍 经 网 络 : 神经 网 络 是 有 序 三 元 组 {Qa，P，y}: af 代表 神经 元 ; B 代 表 集 合 { (x, y) |x，yEN}， 其 中 元 素 是 神经 元 x 到 神经 y 
元 的 连接 ; ΜΥ: 一 R 定 义 权 重 ，Y (x, y) 为 神经 元 x 到 神经 元 y 的 连接 的 权重 。 数 据 在 神经 元 之 间 的 连接 传递 ， 连 接 权重 是 
兴 否 性 或 抑制 性 的 。 


10.2 为 S&P 500 建 模 


纽约 证 卷 交 易 所 或 纳 斯 达 克 绪 合 指 数 上 市 的 500 家 最 大 的 公司 股票 的 价值 是 以 S&P 500 测 量 得 到 的 。 基 于 股票 价格 ，S&P 
500 提 供 快速 查看 股票 市 场 和 经 济 的 走势 。S&P 500 指 数 是 金融 媒体 和 专业 人 士 最 常用 的 指标 ， 计 算 方 法 为 : 先 求 所 有 S&P 500 
股票 调整 后 的 市 值 咏 和 和 ， 然 后 除 以 S&P 开发 的 指数 (除数) 。 当 存在 可 能 影响 指数 价值 的 股票 分 割 、 特 殊 股 息 或 分 拆 时 ， 除 数 
进行 调整 。 除 数 确 保 这 些 非 经 济 因素 不 影响 指数 。 


准备 工作 
我 们 使 用 GSPC 数 据 集 来 构建 S&P 500 指 数 。 
第 1 步 : 收集 和 摘 述 数据 


数据 集 选取 从 2009 年 1 月 1 日 起 至 2014 年 1 月 1 日 的 CSPC 每 日 股票 收盘 价 。 我 们 要 下 载 的 数据 集 可 以 在 以 下 网 址 免费 获 


4B. 
fs: 


http://yahoo.com, 


具体 实施 步骤 


^ 


yE 
^ 


以 下 为 实现 细节 。 


第 2 步 : 探索 数据 


首先 需要 加 载 以 下 软件 包 : 


install .packages ("quantmod") 
install.packages ("neuralnet") 
library (quantmod) 
library (neuralnet) 


V V V V 


现在 开始 标记 所 需 数 据 时 间 段 的 起 始 时 间 和 结束 时 间 ， 并 下 载 数 气 。 
ERas.Date () 用 于 将 字符 表示 的 日 期 转换 为 Date 类 对 象 。 
数据 集 的 初始 日 期 存储 在 startDate 中 ， 表 示 格 式 为 YYYY-MM-DD: 


startDate = as.Date("2009-01-01") 


数据 集 的 结束 日 期 存储 在 endDate 中 ， 表 示 格 式 为 YYYY-MM-DD: 


> endDate = as.Date("2014-01-01") 


使 用 函数 getSymbols () 加 载 数据 。 该 函数 从 本 地 或 远程 的 多 个 源 加 载 数据 。GSPC 为 字符 向 量 ， 指 定 需 要 加 载 的 符号 
src=yahoo 代 表 数 据 源 : 


> getSymbols("^GSPC", src="yahoo", from-startDate, to=endDate) 


AS of 0.4-0, 'get5ymbols' uses env-parent.frame() and 
auto.assign-TRUE by default. 


This behavior will be phased out in 0.5-0 when the call will 

default to use auto.assign-FALSE. getoprion("getsymbols.env") and 
getOptions("getsSymbols.auto.assign" ) are now checked for alternate defaults 
This message is shown once per session and may be disabled by setting 


options("getSymbols.warning4.0"—-FALSE). See ?getSymbols for more details. 
[1] "csPc" 


第 3 步 : 计算 指标 


计算 相对 强度 指数 。 相 对 强度 指数 是 近期 上 涨 价格 走势 与 绝对 价格 走势 的 比率 ， 这 里 使 用 遂 数 RSI () 来 计算 相对 强度 指 
数据 框 GSPC 表 示 价 格 系列 ，n=3 表 示 移 动 平均 线 的 周期 数 。 结 果 存 储 在 数据 框 relativeStrengthindex3 中 : 


> relativeStrengthIndex3 <- RSI (Op (GSPC) ,n=3) 


使 用 函数 summary () RRELA., ZARE RHE, LAtkpkItErelativeStrengthIndex3 


的 概要 结 


> summary (relativeStrengthIndex3) 


结果 如 下 : 


Index 
Min. : 2009-01-02 
lst Qu.:2010-04-05 
Median :2011-06-30 
Mean : 2011-07-02 
3rd Qu. :2012-09-27 
Max. : 2013-12-31 


EMA 


Min. 
lst Qu 


Median : 


Mean 
3rd Qu 
Max. 
NA ` S 


: 1.244 
2.5.33. SENE 


. - 80. 360 


函数 EMA () 使 用 符号 GSPC 代 表 价格 系列 ，n= 5 代表 平均 线 的 时 间 段 ， 结 果 存储 在 数据 框 exponentialMovingAverage5 


中 : 


> exponentialMovingAverage5 <- EMA (Op (GSPC) ,n=5) 


萌出 exponentialMovingAverage5 数 据 框 。 使 用 函数 head () 返回 exponentialMovingAverage5 数 据 框 的 头 部 数 
据 ，exponentialMovingAverage5 作 为 函数 的 输入 人 参数: 


> head(exponentialMovingAverage5) 


结果 如 下 : 

EMA 
2009-01-02 NA 
2009-01-05 NA 
2009-01-06 NA 
2009-01-07 NA 


2009-01-08 919.3020 
2009-01-09 916.1713 


使 用 函数 summary () 探索 价格 变化 的 概要 。 该 消 数 提供 一 系列 描述 性 统计 信息 ， 以 生成 数据 框 
exponentialMovingAverage5 的 概要 结 


> summary (exponentialMovingAverage5) 


结果 如 下 : 


Index 
Min. : 2009-01-02 
lst Qu.-:2010-04-05 
Median :2011-06-30 
Mean :2011-07-02 
3rd Qu. :2012-09-27 
Max. : 2013-12-31 


EMA 


Min. 
lst Qu.: 
median 
Mean 

3rd Qu.: 
Max. 
NA'S 


: 692 


1103 


:1281 
:1275 


1411 


:1836 
-4 


计算 GSPC 开 盘 价 的 指数 与 exponentialMovingAverage5 之 间 的 差 值 : 


> exponentialMovingAverageDiff <- Op(GSPC) - exponentialMovingAverage5 


输出 exponentialMovingAverageDiff 数 据 框 。 使 用 为 数 head () 返回 exponentialMovingAverageDiff 数 据 框 的 头 部 数 
据 ，exponentialMovingAverageDiff 作 为 为数 的 输入 参数 : 


> head(exponentialMovingAverageDiff) 


结果 如 下 : 

GSPC.Open 
2009-01-02 MA 
2009-01-05 MA 
2009-01-06 MA 
2009-01-07 NA 


2009-01-08 -13.572010 
2009-01-09 -6.261344 


使 用 函数 summary () 探索 价格 变化 的 概要 。 该 函数 提供 一 系列 摘 述 性 统计 信息 ， 以 生成 数据 框 
exponentialMovingAverageDiff 的 概要 结 


> summary (exponentialMovingAverageDiff) 


结果 如 下 : 


Index GSPC. Open 
Min. : 2009-01-02 Min. 2-75. 717 
lst Qu.:2010-04-05 lst Qu.: -5.220 
Median :2011-06-30 | Median : 3.261 


Mean : 2011-07-02 Mean : 1.451 

3rd Qu. :2012-09-27 3rd Qu.: 8.777 

Max. :2013-12-31 Max. : 38.711 
NA 5 :4 


比较 GSPC 系 列 的 快速 移动 平均 线 与 G6SPC 系 列 的 缓慢 移动 平均 线 。GSPC 以 价格 矩阵 的 方式 作为 输入 参数 。fast=12 表 示 快 
速 移动 平均 线 的 周期 ，slow=26 表 示 缓 慢 移动 平均 线 的 周期 ，signal= 9 表示 移动 平均 绪 的 信号 : 


> MACD <- MACD (Op (GSPC) , fast = 12, slow = 26, signal = 9) 


输出 MACD 数 据 框 。 使 用 函数 tail () 返回 MACD 数 据 框 的 尾部 数据 ，MACD 作 为 溺 数 的 输入 参数 : 


> tail (MACD ) 


结果 如 下 : 


macd signal 
2013-12-23 0.4584068 0.4360493 
2013-12-24 0.5525735 0.4593541 
2013-12-26 0.6503602 0.4975553 
2013-12-27 0.7/544246 0.5489292 
2013-12-30 0.8202862 0.6032006 
2013-12-31 0.8671819 0.6559969 


使 用 函数 Summary () 探索 价格 变化 的 概要 : 


> summary (MACD) 


结果 如 下 : 


Index macd signal 
Min. : 2009-01-02 Min. -—55. 62181 Min. --4.77728 
ist Qu. «2010-04-05 lst Qu. :-0. 09344 lst Qu. :-0. 04305 
Median :2011-06-30 Median : 0.63804 Median : 0.61565 
Mean : 2011-07-02 Mean : 0.39505 Mean : 0.40129 


3rd Qu. :2012-09-27 3rd Qu.: 1.13639 3rd Qu.: 1.08340 
Max. 2013-12-31 Max. . 2.04747 Max. : 2.63443 
NA'S :25 NA ` 5 :- 33 


选取 信号 线 作 为 指标 。 结 果 存 储 在 数据 框 MACDsignal 中 : 


> MACDsignal <- MACD[,2] 
计算 布 林 线 。 布 林 线 是 沁 围 界定 的 措 标 ， 用 于 计算 移动 平均 线 的 标准 差 。 布 林 线 是 以 货币 对 的 价格 最 有 可 能 趋向 于 平均 水 平 
的 逻辑 运作 的 ， 因 此 当 它 偏离 太 远 时 ， 例 如 距离 两 个 标准 差 ， 便 回溯 到 其 移动 平均 线 。 使 用 水 数 BBands () 用 于 计算 布 林 


线 ，GSPC 作 为 函数 的 输入 参数 ， 该 对 象 被 更 改 为 矩阵 ， 其 中 包 合 最 高 一 最 低 一 收盘 价格 ，n=20 表 示 移 动 平均 数 的 周期 
数 ，sd=2 表 示 两 个 标准 偏 磊 : 


> BollingerBands <- BBands (Op (GSPC) ,n=20, sd=2) 


输出 数据 框 BollingerBands: 


> tail(BollingerBands) 
结果 如 下 : 


dn mavg up pctB 
2013-12-23 1773.709 1798.316 1822.924 0.9999155 
2013-12-24 1771.752 1799.401 1827.050 1.0175470 
2013-12-26 1769. 309 1801.005 1832.701 1.0356273 
2013-12-27 1766.374 1802.980 1839.586 1.0462175 
2013-12-30 1764.382 1804.619 1844.856 0. 9570193 
2013-12-31 1762.902 1806.422 1849.942 00.9157658 


探索 价格 变化 的 概要 : 
> summary (BollingerBands) 


结果 如 下 : 


Index 


Min. 
lst Qu.: 
Median 
Mean 

3rd Qu.: 
Max. 


: 2009-01-02 


2010-04-05 


- 2011-06-30 
: 2011-07 -02 


2012-09-27 


:2013-12-31 


dn 

Min. : 650. 
lst Qu. «1060. 
Median :1245. 
Mean :1232. 
3rd Qu. :1380. 
Max. :1779. 
NA 5 :19 


从 BollingerBands 选 取信 号 线 作 为 指标 : 


mavg 


Min. 


Median 
Mean 


A 00 NJ ο N NJ 


Max. 
NA'S 


lst Qu. 


3rd Qu. 


. 736.7 
:1103. 0 
:1282.9 
:1273.7 
:1408. 0 
:1806.4 
:19 


> PercentageChngpctB <- BollingerBands[,4] 


输出 数据 框 PercentageChngpctB: 


> tail(PercentageChngpctB) 


结果 如 下 : 


pctB 


2013-12-23 0.9990155 
2013-12-24 1.017547/70 


2013-12-26 1.03562/3 
2013-12-27 1.0462175 
2013-12-30 O. 9579193 
2013-12-31 0.915/658 


探索 PercentageChngpctB 价 格 变化 的 概要 : 


> summary (PercentageChngpctB) 


结果 如 下 : 
Index 

Min. : 2009-01-02 
lst Qu.:2010-04-05 
Median :2011-06-30 
Mean :2011-07-02 
3rd Qu. :2012-09-27 
Max. :2013-12-31 


得 找 开 盘 价 和 收盘 价 乙 间 的 差别 : 


> Price «- CIl(GSPC)-Op(GSPC) 


输出 数据 框 Price: 


> tail(Price) 


结果 如 下 : 


. 3308 
«3/90 
. 7077 
.6110 
. 8649 
. 2875 


up 

Min. : 805.1 
lst Qu.:1141.1 
Median :1322.8 
Mean = 
3rd Qu. :1440.0 
Max. :1849. 9 
NA'S :19 


pctB 
Min. :一 
lst Qu.: 
Median : 
Mean 
3rd Qu.: 
Max. 
NA'S - l 


oPoooco 


GSPC.Close 
2013-12-23 5. 069946 
2013-12-24 5.200026 
2013-12-26 7 . 060059 
2013-12-27 -1.569% 7 
2013-12-30 -0.400025 
2013-12-31 5.750000 


Ee WustErelativestrengthIndex3, expMvAvg5Cross, MACDsignal, Percentage Chngpct B 和 Price， 结 果 保 存在 数 
据 框 DataSet 中 : 


> DataSet <- data.frame(relativeStrengthIndex3, expMvAvg5Cross, 
MACDsignal, PercentageChngpctB, Price) 


探索 DataSet 数 据 框 的 内 部 结构 。 使 用 遂 数 str () 探索 作为 R 对 象 的 Dataset 数 据 框 的 内 部 结构 : 


> str(DataSet) 


结果 如 下 : 
"data.frame': 1258 obs. of 5 variables: 
$ EMA : num ΝΑ NA ΝΑ 88.3 43.7 ... 
$ GSPC.Open : num ΝΑ ΝΑ ΝΑ NA -13.6 ... 
$ signal : num ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ NA ... 
$ pctB : num ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ΝΑ ... 
$ GSPC.Close: num 28.81 -1.72 3.53 -20.8 4 ... 


计算 指标 ， 创 建 数据 集 ， 删 除 点 : 


> DataSet «- DataSet[-c(1:33),] 


探索 数据 框 DataSet 的 维度 。 使 用 dim () 函数 返回 数据 框 Dataset 的 维度 ，Dataset 作 为 函数 的 输入 参数 。 返 回 结果 清楚 
地 显示 数据 框 有 1176 行 数据 和 5 列 |: 


> dim(DataSet) 


结果 如 下 : 


[1] 1176 3 


HIE. Kc () 用 于 将 参数 组 合成 向 量 : 


> colnames (DataSet) <- 
cC("RSI3","EMAcross"," MACDsignal","BollingerBP", Price") 


探索 DataSet 数 据 框 的 维度 : 


> str(DataSet) 


结果 如 下 : 


"data.frame': 1225 obs. of 5 variables: 

$ RSI3 : num 6.99 6.32 2.47 46.69 41.4 ... 

$ EMACrOSS : num -21.45 -16.05 -29.74 -2.53 -4.94 ... 

$ MACDsignal: num -1.78 -1.98 -2.24 -2.45 -2.64 ... 

$ BollingerB: num -0.06817 -0.00641 -0.10584 0.138 0.1466 ... 
$ Price : num -5.82 -29.92 28.45 -5.74 -12.93 ... 


第 4 步 : 准备 数据 构建 模型 

将 数据 集 归 一 化 至 区 间 [0，1]: 

> Normalized <- function(x) ((x-min(x))/ (max (x)-min (x) ) } 
HARRISE SN: 
> NormalizedData <- as.data.frame (lapply (DataSet, Normalized) ) 
输出 数据 框 NormalizedData: 

> tail(NormalizedData) 

结果 如 下 : 


RSI3 EMACross X MACDsignal BollingerB Price 
1220 0.8949682266 0.8039542230 0./033909/06 0.8223095381 0.6403435993 
1221 0.9168950078 0.7/862496259 0.7/065352979 0.8332047211 0.6420948929 
1222 0.9425533165 0./851664068 0.7116894675 0.8443/720/7 0.6554982/46 
1223 0.963/4509/7 0./906/86046 0./186209104 0.8509212683 0.589/809313 
1224 0.8805/25/68 0./3894/0017 0.7259432951 0./9635855/6 0. 5986898667 
1225 0.891/1/2659 0./19840288/ 0./330666522 0.//703103038 0.6455221985 


创建 训练 数据 集 。 数 据 杠 NormalizedData 的 1: 816 的 数据 元 素 用 于 训练 数据 集 ， 结 果 保 存在 TrainingSet 中 : 


> TrainingSet <- NormalizedData[1:816,] 
探索 数据 框 TrainingSet 的 维度 : 

> dim(TrainingSet) 

结果 如 下 : 

[1] 816 5 


探索 数据 框 TrainingSet 的 概要 : 


> summary (TrainingSet) 


结果 如 下 : 


> summary (TestSet) 


H 


~ 


Ν 


~ 


RSI3 
Min. 


Median 
Mean 


创建 测试 数据 集 。 


:0. 
1st Qu. :0. 
:0. 
:0. 
3rd Qu. :0. 
Max. :1. 


004723371 
345216893 
621185723 
5371760152 
808167123 
000000000 


EMACFOSS 


Min. 
1st Qu.: 
Median 
Mean 

3rd Qu. : 
Max. 


:0. 0000000 


0.6129767 


:0. 6903207 
:0. 6733781 


0.7399376 


:1. 0000000 


MACDsignal 
:0. 0000000 


Min. 
1st 
Medi 
Mean 
3rd 
Max. 


Qu. : 
an 


0. 6219857 


:0. 7327540 


:0. 6966899 


Qu. : 


0. 8091630 


:1. 0000000 


» TestSet «- NormalizedData[817:1225 , 


探索 数据 框 TestSet 的 维度 : 


> dim(TestSet) 


结果 如 下 : 


[1] 409 3 


探索 数据 框 TestSet 的 概要 : 


结果 如 下 : 


数据 框 NormalizedData 的 816: 1225 的 数据 元 素 用 于 训 


] 


Relative Strength Index3 Exp Moving Avg5Cross MACD Signal 


Min. 


: 4.671 


lst Qu. :39.035 
median :64.992 


Mean :59. 845 
3rd Qu. :80.769 
Max. :98. 988 
NA's :49 


第 5 步 : 构建 模型 


构建 神经 网 络 : 


Price ~ RSI3+EMAcross+MACDsignal+BollingerB 描 述 待 拟 合 模 


Min. :-30. 553 
lst Qu.: -3.277 
median : 3.927 
Mean 2. 684 
3rd Qu.: 8.664 
Max. : 28.171 
NA'S :49 


Min. :-1.0854 
lst Qu.: 0.3320 
Median : 0.6771 
Mean : 0.5522 
3rd Qu.: 0.9498 
Max. : 1.3574 
NA ` 5 :49 


函数 neuralnet () 使 用 无 权重 回溯 的 反 向 传播 算法 训 


Min. 
ist Qu.:0.4313891 
Median 
Mean 

3rd Qu. :0.7358875 
Max. 





AJ 


στι 


BollingerB 
:0. 0000000 


:Ὁ. 6440188 
:0. 5788036 


:1. 0000000 





Price 


Min. 
1st Qu.: 
Median 
Mean 

3rd Qu. : 
Max. 


Bollinger Bands Percentage 


Min. :-0. 2714 
lst Qu.: 0.4582 
Median : 0.7307 
Mean : 0.6464 
3rd Qu.: 0.8767 
Max. : 1.2709 
NA'S :49 
练 神 经 网 络 。 


:0. 0000000 


0. 5609580 


:0. 6109499 
:0. 6071108 


0. 6604099 


:1. 0000000 


练 数据 集 ， 结 果 保 存在 TestSet 中 : 


Price Diff 
Min. :-36.480 
lst Qu.: -4.952 
median 1.360 
Mean 1.290 
3rd Qu 7.453 
Max. : 36.230 
NA ` S :49 


数据 框 qata=TrainingSet 包 含 公式 中 指定 变 


hidden=c (3, 3) 代表 每 一 层 隐藏 神经 元 (顶点 ) 的 数量 ，learningrate=0.001 表 示 反 辣 传播 算法 的 学 习 
algorithm="backprop" 代 表 反 向 传播 算法 : 


> 


nnl <- 


neuralnet (Price-RSI3-EMAcross-*MACDsignaltBollingerB,data-TrainingSet, 
learningrate-.001,algorithm-"backprop") 


hidden=c (3, 3), 


绘制 神经 网 络 : 


» BLOt (ηηΊ1) 


结果 如 下 : 


RSI3 


EMAcross 


MACDsignal -ᾱ 








Error: 4.40823 Steps: 67106 


10.3 ”衡量 失业 率 


失业 率 定 义 为 失业 ， 但 积极 寻求 残 业 且 有 意愿 工作 的 总 秀 动 力 的 百分比 。 根 据 国 际 秀 工 组 织 (International Labor 


Organization, ILO) 的 定义 ， 失 业 人 员 是 正在 积极 寻找 工作 但 没有 工作 的 人 。 失 业 率 是 衡量 失业 人 员 的 指标 。 


准备 工作 


我 们 使 用 威斯康星 州 的 失业 率 来 搭建 神经 网 络 ， 用 于 衡量 失业 率 。 


第 1 步 : 收集 和 摘 述 数据 


选用 的 数据 集 FRED-WIUR.csv 是 一 种 可 访问 的 CSV 格 式 标准 数据 集 ， 和 存储 448 行 数据 ， 其 中 数值 型 变量 包括 : 


: Date 


: Value 


数据 集 显 示 了 威斯康星 州 在 1976 年 1 月 1 日 至 2013 年 1 月 1 日 之 间 的 失业 率 。 


具体 实施 步骤 


以 下 为 实现 细节 。 


第 2 步 : 探索 数据 


首先 需要 加 载 以 下 软件 包 : 


install.packages("forecast ") 
install.packages("lmtest") 
install.packages("caret ") 
library(forecast) 

library (lmtest) 

library (caret) 


V V V V V V 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.3.0。 


现在 开始 探索 数据 并 理解 参数 之 间 的 关系 。 我 们 导入 FRED-WIUR.csv 数 据 集 并 保存 为 数据 框 ud : 


> ud <- read.csv("d:/FRED-WIUR.csv", colClasses=c('Date'='Date')) 


输出 ud 数据 框 。 使 用 陪 数 tail () 返回 ud 数据 框 的 头 部 数据 ，ud 作 为 冰 数 的 输入 参数 : 


> tail(ud) 


结果 如 下 : 


DATE VALUE 
443 1976-06-01 
444 1976-05-01 
445 1976-04-01 
446 1976-03-01 
447 1976-02-01 
448 1976-01-01 


C un Ln un un un 
ο uh un T 


HIEM. Kc () 用 于 将 参数 组 合成 向 量 : 


> colnames (ud) <- c('date', 'rate') 


BEEas.Date () 用 于 将 字符 表示 的 日 期 转换 为 Date 类 的 日 历 对 象 : 


> ud$date <- as.Date(ud$date) 


使 用 六 数 sSummary () RRR, ZAER Ξ«ΡΙΗΗΗΣΙΕΘΕΥΤΙΠΑΕΑ, LATERI EU dB SR asa : 


» summary (ud) 


结果 如 下 : 
date rate 

Min. :1976-01-01 Min. 3. 000 
1st Qu. :1985-04-21 1st Qu.: 4.400 
Median :1994-08-16 | Median : 5.100 
Mean :1994-08-16 Mean : 5.675 
3rd Qu. :2003-12-08 3rd Qu.: 7.000 
Max. :2013-04-01 Max. :11. 900 


使 用 数据 集中 1 至 436 行 创建 训练 数据 集 : 


> ud.b <- ud[1:436,] 


使 用 函数 summary () 探索 基础 失业 率 的 概要 ， 该 函数 提供 一 系列 质 述 性 统计 信息 ， 以 生成 数据 框 ud.b 的 概要 结果 : 


> summary (ud.b) 


结果 如 下 : 
date rate 
Min. :1977-01-01 Min. : 3.000 
ist Qu. :1986-01-24 lst Qu.: 4.400 
Median :1995-02-15 Median : 5.000 
Mean :1995-02-15 Mean : 5.679 
3rd Qu. :2004-03-08 3rd Qu. 7.100 
Max. :2013-04-01 Max. «11. 900 


使 用 数据 集中 437 至 448 行 创建 测试 数据 集 : 
> ud.p «- ud[437:448,] 


使 用 遂 数 summary() 探索 测试 失业 率 的 概要 : 


> summary (ud .P) 
结果 如 下 : 


date rate 
Min. :197 6-01-01 Min. 5. 
lst Qu..:1976-03-24 lst Qu.:5. 
Median :1976-06-16 X Median :5. 
Mean :1976-06-16 Mean 23. 550 
3rd Qu. :1976-09-08 3rd Qu. :5. 
Max. :1976-12-01 Max. :6 


创建 从 1976 年 起 的 基线 时 间 序 列 。 函 数 ts () 创建 时 间 序 列 对 象 ，ud.b$rate 代 表 观 测 的 时 间 序 列 值 的 向 量 : 
> ud.ts «- ts(ud.b$rate, start-c(1976, 1), frequency-12) 
输出 数据 框 ud.ts: 


> ud.ts 


结果 如 下 : 


Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec 
1976 6.8 6.9 6.9 6.9 6.9 6.9 6 7.0 7.0 7.1 7.1 7.1 
1977 7.1 7.1 7.1 7.1 7.2 7.4 7.5 7.6 7.7 7.8 7.8 7.8 
1978 7.9 7.9 7.9 8.0 8.1 8.2 8.3 8.3 8.4 8.4 8.5 8.7 
1979 8.9 9.0 9.1 9.2 9.2 9.1 9.1 9.0 9.0 9.0 8.9 8.8 
1980 8.6 8.2 7.7 7.2 6.6 6.0 5.6 5.2 5.0 4.8 4.6 4.5 
1981 4.4 4.4 4.5 4.6 4.8 4.9 5.0 5.0 5.1 5.0 5.0 4.9 
1982 24.9 4.9 4.9 4.9 4.9 4.9 4.8 4.8 4.8 4.7 4.7 4.7 
1983 4.7 4.7 4.7 4.7 4.8 4.8 4.8 4.8 4.7 4.7 4.6 4.6 
1984 4.6 4.6 4.7 4.7 4.8 4.8 4.8 4.9 4.9 5.0 5.0 5.1 
1985 5.1 5.2 5.3 5.3 5.4 5.5 5.6 5.7 5.8 5.8 5.8 5.8 
1986 5.8 5.8 5.7 5.6 5.5 5.4 5.4 5.3 5.3 5.3 5.3 5.4 
1987 5.4 5.5 5.5 5.4 5.3 5.1 4.9 4.8 4.6 4.5 4.5 4.4 
1988 4.3 4.2 4.1 3.9 3.8 3.7 3.7 3.7 3.7 3.7 3.6 3.5 


PEERI. BEEXts () 创建 时 间 序 列 对 象 ，ud.p$rate 代 表 观 测 的 时 间 序 列 值 的 向 量 : 


> ud.p.ts <- ts(ud.p$rate, start=c(2012, 5), frequency-12) 


输出 数据 框 ud.p.ts: 


> ud.ts 


结果 如 下 : 


Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec 
2012 5.5 5.4 5.4 5.4 5.4 5.4 5.4 5.5 
2013 5.6 5.7 5.9 6.0 


绘制 基线 时 间 序列 数据 : 


> plot.ts(ud.ts) 


结果 如 下 : 


12 


10 


ud.ts 


1980 1990 2000 2010 


时 间 


绘制 测试 时 间 序列 数据 : 


> plot.ts(ud.p.ts) 


结果 如 下 : 


6.0 
l 


5.9 
| 


ud.p ts 
5.6 5.7 
| | 
κ 
M. 


5.5 
l 
/ 
N 


54 





2012.4 2012.6 2012.8 2013.0 2013.2 


第 3 步 : 准备 和 验证 模型 


计算 基线 时 间 序 列 数据 的 均值 。 函 数 meanf () 返回 应 用 于 ud.ts 数 据 集 的 ii.d 模 型 的 预测 和 预测 间隔 ， 参 数 12 表 示 预 测 周 
HB: 


» mean «- meanf(ud.ts, 12) 


^ h < h 
X ak E X, +>, x = X, eer n =i) 9 


AI (ΠΕ: AES, BASAAR ESSORSBSSE SES S : 一 一 译 者 注 ) 基线 时 间 
序列 预测 随机 漫步 的 间隔 。 阔 数 rwf () 预测 并 返回 在 时 间 序 列 ud.ts 上 执行 的 随机 漫步 ， 参 数 12 表 示 预 测 周期 : 


> forecast randomwalk «- rwf(ud.ts, 12) 


ARIMA (0, 0, 0) (0, 1, 0) mZERSTEIFRZUBSBS T US ZZ BSTRAURITRIR)S. &EXsnaive () 预测 并 返回 在 时 间 序 列 
ud.ts 上 执行 的 ARIMA (0, 0, 0) (0, 1, 0) m, S3X12z&zr iol s] BB : 


> forecast arima «- snaive(ud.ts, 12) 


TRU ESEERSTIRIERTUBSSEE. BREXIwT () 预测 并 返回 在 时 间 序 列 ud.ts 上 执行 的 随机 漫步 ， 参 数 12 表 示 预 测 周 期 ，drift=T 代 
表 飘 移 模 型 的 随机 漫步 的 逻辑 标志 : 


> drift «- rwf(ud.ts, 12, drift=T) 
接 下 来 ,我 们 将 为 基线 时 间 序 列 数据 的 趋势 准备 线性 拟 合 模型 。 函 数 tsIm () 为 时 间 序 列 ud.ts 进 行 线性 模型 拟 合 ，ud.ts ~ 
trend 表 示 趋 势 分 量 必须 考虑 的 公式 : 


> ml <- tslm(ud.ts-trend) 


为 基线 时 间 序 列 数据 的 趋势 和 季节 性 准备 线性 拟 合 模型 。 函 数 tsIm () 为 时 间 序 列 ud.ts 进 行 线性 模型 拟 合 ，ud.ts ~ 
trend+season 表 示 趋 势 分 量 必 须 考 虑 的 公式 : 


> m2 <- tslm(ud.ts-trend-tseason) 


residuals () z&à— T 3S FBHERZA, CERRAR AMARRA, MRM HENE. 
» residual 1 «- residuals (m1) 
绘制 残疾 模型 : 


> plot(residual 1, ylab="Residuals",xlab="Year", title("Residual - 
Trends"), col = "red") 


结果 如 下 : 





1980 1990 2000 2010 
年 份 


现在 来 看 看 如 何 估计 上 自动 协 万 差 消 数 ，residual_1 是 蛙 变 量 数字 时 间 序 列 对 象 : 


> acf(residual, 1, main-z"ACF of residuals") 


结果 如 下 : 


ACF 22 


1.0 


0.6 0.5 


ACF 


0.4 


0.2 


0.0 





0.0 0.5 10 | 2.0 
Lag 


residuals () 是 一 个 通用 函数 ， 它 在 针对 基线 时 间 序 列 数据 的 趋势 拟 合 模型 返回 后 ， 从 对 象 m1 中 提取 模型 残 笑 。 


> residual 2 <- residuals (m2) 


绘制 残疾 模型 : 


> plot (residual 2, ylab="Residuals",xlab="Year",title("Residual - 
Trends + Seasonality"), col = "red") 


结果 如 下 : 


FER GAIRE 


残 差 


-2 


1980 1 2010 


990 
年 份 


> acf (residual 2, main="ACF of residuals") 


结果 如 下 : 


ACF 242: 


1.0 


06 0.8 


ACF 
0.4 


0.2 


0.0 





0.0 0.5 1.0 1.5 20 
Lag 


执行 Durbin-Watson 测 试 来 确定 线性 回归 或 多 个 回归 的 残 差 是 否 是 独立 的 。 通 常 在 Durbin-Watson 测 试 中 考虑 的 假设 如 


Ho: P=0 
H,: P>0 


测试 统计 如 下 : 


ESRI 中 ，y 是 个 体 i 的 观测 值 ， 而 ” 是 个 体 的 预测 值 ， 
随 着 连续 相关 性 的 增加 ，d 值 降低 。 上 临界 值 和 下 临界 值 qu 和 d 已 经 列 出 了 不 同 的 k 值 (解释 变量 的 数量 ) 和 ni 
如 果 d<dL， 拒 绝 Ho: ΡΞ0; 


如 果 d<du， 不 拒绝 Ho: ΡΞ0; 


如 果 dl <d<duU， 测 试 没 有 结果 。 
对 基线 时 间 序 列 数 据 趋势 的 线性 拟 合 模型 进行 Durbin-Watson 测 试 : 


> dwtest (m1, alt-"'"two.sided") 


结果 如 下 : 


Durbin-watson test 


data: m 
Dw = 0.0065342, p-value < 2.2e-16 
alternative hypothesis: true autocorrelation is not O 


对 基线 时 间 序 列 数据 趋势 和 季节 性 的 线性 拟 合 模型 进行 Durbin-Watson 测 试 : 


> dwtest (m2, alt="two.sided") 


结果 如 下 : 


Durbin-Watson test 


data: m2 
DW = 0.0065138, p-value < 2.2e-16 
alternative hypothesis: true autocorrelation is not 0 


fSRFBLOESSTSHEEESESTTRIERUATSEZJISRB. SET. ESSSAUT ARAS: 


> m3 <- stl(ud.ts, s.window-'periodic') 


绘制 分 解 的 基线 时 间 序 列 : 


> plot (m3) 


结果 如 下 : 
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1980 1990 2000 2010 


时 间 


为 基线 时 间 序 列 数据 执行 指数 平滑 状态 空间 模型 。 销 数 ets () 返回 ud.ts 时 间 序 列 上 的 ets 模 型 。ZZZ 中 的 “Z” 表 示 上 自动 选 


第 一 个 字母 表示 错误 类 型 ， 第 二 个 字母 表示 趋势 类 型 ， 第 三 个 字母 表示 季 广 类 型 : 


~ 


> m4 <- ets(ud.ts, model-'ZZZ') 


绘制 基线 时 间 序列 数据 的 指数 平滑 状态 空间 模型 ; 


> plot (m4) 


结果 如 下 : 


ETS (M, Ad, N) Jrik fits 


level observed 


slope 


1980 1990 2000 2010 


时 间 


返回 基线 时 间 序 列 数 据 的 单 变量 ARIMA 的 顺序 : 


> m5 «- auto.arima(ud.ts) 


绘制 基线 时 间 序列 数据 的 单 变量 ARIMA: 
> plot (forecast (m5, h=12)) 
结果 如 下 : 


ARIMA (1, 1, 2) 预测 


12 


10 


1980 1990 2000 2010 


HERRIRA, pEEEnnetar () HÆRS ER EUER mA AAN, FH TudsBarmEERJIRIERSA 
数据 : 


> m6 «- nnetar(ud.ts) 


输出 前 馈 神 经 网 络 模型 的 值 : 


> m6 


结果 如 下 : 


Series: ud.ts 
Model: NNAR(26,1,14) [12] 


Call: nnetar(y = ud. ts) 


Average of 20 networks, each of which is 
a 26-14-1 network with 393 weights 
options were - linear output units 


sigma? estimated as 0.002508 
绘制 前 馈 神 经 网 络 模 型 : 


> plot (forecast (m6, h=12)) 


结果 如 下 : 


基于 NNAR (26, 1, 14) [12] 进行 预测 


12 


10 


1980 1990 2000 2010 


第 4 步 : 预测 和 测试 构建 模型 的 准确 性 


使 用 测试 时 间 序 列 数据 来 测试 基线 数据 时 间 序 列 均值 的 精度 。 晃 数 accuracy () 返回 预测 精度 的 汇总 度量 范围 ，ud.p.ts 是 
测试 数据 时 间 序 列 : 


> al «- accuracy(mean, ud.p.ts) 
使 用 飘移 测试 预测 的 基准 数据 时 间 序 列 的 精度 : 
> a2 <- accuracy(forecast randomwalk, ud.p.ts) 


使 用 ARIMA (0, 0, 0) (0, 1, 0) m 测 试 预 测 的 基线 时 间 序 列 数据 的 精度 : 


> a3 <— accuracy(forecast arima, ud.p.ts) 


测试 基线 数据 时 间 序 列 的 飘移 精度 : 


> a4 <- accuracy (drift, 


将 结果 整合 至 表 : 


JA 


> a.table <- rbind(al, 


输出 结果 : 


> a.table 


结果 如 下 : 


Training 
Test set 
Training 
Test set 
Training 
Test set 
Training 
Test set 


预测 基线 时 间 序 询 数据 趋势 的 线性 拟 合 模型 ， 


ME 


.159009e-17 
.288991e-01 
. 218391e-03 
. 500000e-01 
. 212264e-02 
.,333333e-01 
.83/714e-16 
. 532184e-01 


oocomnooon 


> fl <- forecast (m1, h-12) 


UE zH: [8] 9 GS BER AE ΕΗ“ e PETIT UE : 


> f2 <- forecast (m2, h-12) 


预测 使 用 LOESS 将 基线 时 间 序 列 分 解 为 周 


> f3 <- forecast (m3, h-12) 


预测 基线 时 间 序 列 数据 的 指数 平滑 状态 空间 模型 : 


> f4 «- forecast (m4, 


预测 基线 时 间 序 列 数据 的 有 序 单 变量 ARIMA: 


h=12) 


> f5 «- forecast (m5, h-12) 


预测 单 隐藏 层 的 前 馈 神 经 网 络 模 型 : 


> f6 <- forecast (m6, h=12) 


ΓΩ 


μι 
Ρο HE £N HP RO 


σα, σι σα 
a2, a3, a4) 

RMSE MAE MPE 
.9019099 1.53702129 -10.31273981 
.2396838 0.22278287  -2.45281447 
.1526773 0.09287356  -0.08228355 

2516611 0.15000000 2. 57879386 
2587336 0.82665094 -2. 87606055 
-4377975 0.43333333  7.78692151 
.1526433 0.09443467 .-0.01973132 
.2535926 0.15321839  2.63685674 
h=12 表 示 预 测 周 期 : 
期 、 季 节 、 趋 势 和 不 规则 分 量 : 


MAPE 


. 302156 
. 031039 
. 582567 
. 578794 
. 538198 
- 786922 
-613285 
- 636857 


MASE 


. 8593353 
. 2695005 
.1123492 
.1814551 
. 0000000 
. 5242035 
.1142377 
-1853484 


cooocoooooc 


ACF1 Theil's U 


. 9963622 
. 6989796 
. 6931248 
. 6989796 
. 9830841 
. 3333333 
. 6931248 
. 6989796 


NA 
2. 763092 
NA 
2.818489 
NA 
4.842820 
NA 
2.839636 


测试 基线 时 间 序 列 趋势 的 线性 拟 合 模型 的 预测 精度 : 


> a5 <- accuracy(f1, ud.p.ts) 


Ai ERST TRIER PUES PRESE TO ERIS EH EE BS TUER : 


> a6 <- accuracy(f2, ud.p.ts) 


测试 使 用 LOESS 将 基线 时 | 间 序 列 分 解 为 周期 、 季 节 、 趋 势 和 不 规则 分 量 的 预测 精度 : 


> a7 <- accuracy (f3, ud.p.ts) 


测试 基 绪 时 间 序 列 数 据 的 指数 平滑 状态 空间 模型 的 预测 精度 : 
> a8 «- accuracy(f4, ud.p.ts) 
测试 基线 时 间 序 列 数 据 的 有 序 单 变量 ARIMA 的 预测 精度 : 


> a9 «- accuracy(f5, ud.p.ts) 


测试 单 隐藏 层 的 前 馈 神经 网 络 模型 的 预测 精度 : 


> 810 «- accuracy(f6, ud.p.ts) 


整合 结果 至 表 : 


> a.table.1 <- rbind(a5, a6, a7, a8, 89, 810) 
输出 结果 : 
> a.table.1 
结果 如 下 : 

ME RMSE MAE MPE MAPE MASE ACF1 Theil's U 
Training set 4.475375e-16 1. 88722530 1. 53083801 -10.161145296 28.1539971 1.85185539 Ο0. 9905828645 NA 
Test set -5.487103e-01 0.58297971 0.54871027 -10.023338649 10.0233386 0.66377505 0.695878741 6.671710 
Training set -6.195430e-16 1. 88705289 1. 53086653 -10.158672457 28.1523947 1.85188990 Ο. 9958549775 NA 
Test set -5.492242e-01 0. 58206536 0.54922422 -10.029107757 10.0291078 0.66439678 0.687555685 6.623429 
Training set -9.854464e-04 0.10432066 0.06381823  0.018096634 1.1601990 0.07720094 0.111597690 NA 
Test set 6.097884e-02 0.19531345 0.13899105  0.983630329 2.4283009 0.16813754 0.683262346 2.197669 
Training set -1.015557e-03 0.10565958 0.06330050  0.017500191 1.1509450 0.07657464 0.094513111 NA 
Test set 7.002618e-02 0.20305522 0.14225925  1.143733343 2.4813827 0.17209107 0.686501904 2.279852 
Training set -7.528991e-04 0.10522503 0.06285967  0.022495362 1.1488709 0.07604136 0. 003619751 NA 
Test set 7.395984e-02 0.20312273 0.14102062  1.215641649 2.4575079 0.17059271 0.685511079 2.277821 
Training set 1.892526e-04 0.05007881 0.03839996 -0.007259723 0.7362521 0.04645245 -0.192874177 NA 
Test set 1.551299e-01 0.27955692 0.16401471 2.652956228 2.8174896 0.19840867  0.676462478 3.137278 


«11 ΕΣ] 


本 草 将 涵盖 如 下 内 容 : 


i 循环 神经 网 络 : 预测 周期 信号 


11.1 引言 


大 多 数 机 器 学 习 算 法 对 于 预定 义 的 表征 和 输入 特征 很 有 效 。 机 器 学 习 算 法 优化 权重 以 做 出 最 佳 的 最 终 预 测 ， 而 表征 学 习 
(representation learning) 尝试 目 动 学 习 好 的 特征 或 表征 。 深 度 学 习 算法 尝试 在 多 个 层次 的 表征 中 通过 增加 复杂 性 学 习 。 深 
层 架构 由 多 层次 的 非 线 性 操作 (例如 ， 具 有 许多 隐藏 层 的 神经 网 络 ) 组 成 。 深 度 学 习 技 术 的 主要 目标 是 学 习 特征 层次 结构 ， 可 分 

为 三 大 类 : 用 于 无 监督 学 习 或 生成 学 习 (generative learning) 的 深层 网 络 、 用 于 监督 学 习 的 深层 网 络 和 混合 深层 网 络 。 


11.2 ”循环 伸 经 网 络 : 预测 周期 信号 


振荡 器 是 产生 特定 周期 性 小 形 的 电路 ， 如 方 波 、 三 角 波 、 锯 齿 波 和 正弦 波 。 为 了 严 生 输出 ,振荡 器 通常 使 用 某 种 形式 的 有 源 
器 件 灯 ， 这 些 灯 周围 有 电阻 器 、 电 容器 和 电感 器 。 振 荡 器 主要 有 两 种 类 型 : 弛 驳 振 荡 器 和 正弦 振 汤 器 。 弛 比 振荡 器 用 于 产生 三 角 
波 、 锯 齿 波 和 其 他 非 正弦 波 ， 正 弦 振 荡 器 由 具有 外 部 元 件 的 放大 器 组 成 以 产生 振荡 。 通 常 ， 纯 正弦 波 中 不 存在 谐 泪 ， 由 单一 频率 
组 成 。 


准备 工作 


任务 是 从 噪声 正弦 波 了 预测 余弦 波 。5Hz 频 率 的 正弦 波 具 有 某 一 正 态 分 布 噪声 和 平滑 余弦 波 。 创 建 一 组 包含 10 个 序列 的 数据 
集 ， 每 个 序列 由 40 个 观察 结果 组 成 。 


具体 实施 步 又 
首先 执行 第 一 步 ， 加 载 以 下 软件 包 : 


> install.packages("rnn") 
> library(rnn) 


为 随机 数 设 置 可 重复 性 的 初始 种 子 : 


> set.seed(10) 


切 始 化 所 需 频 率 : 


> f <- 5 


创建 所 需 向 量 : 


> W < 一 2*pi*f 


生成 序列 。 阔 数 seq () 生成 常规 序列 ，0.005 为 初始 值 ，2 为 结束 值 ，by=0.005 定 义 了 增 量 序列 : 


> t «- seq(0.005,2,byz0.005) 


创建 sn 和 cos 值 : 


> x «— sin(t*w) + rnorm(200, 0, 0.25) 
> y <- cos(t*w) 


生成 时 间 序 列 采 样 。 函 数 matrix () 从 x 和 y 的 值 创建 起 孟 ，nrow=40 代 表 所 需 数据 的 行 数 : 


40 ) 
40 ) 


> X <- matrix(x, nrow 
> Y < 一 matrix(y, nrow 


绘制 噪声 波 。 函 数 plot () 为 绘制 R 对 象 的 通用 函数 。 数 据 框 as.vector (X) 为 函数 输出 参数 ，type= "小 代表 绘制 类 型 为 线 


> plot (as.vector (X), colz'blue', type='l', ylab = "x-matrix, y-matrix", 
main - "Noisy waves") 


结果 如 下 : 


Noisy waves 


0.5 1.0 1.5 


x-matrix, y-matrix 
0.0 


0 100 200 300 400 
Index 
> lines(as.vector(Y), col = "red") 
结果 如 下 : 
Noisy waves 





归 一 化 x 的 值 ， 结 果 在 0 和 1 之 间 : 


> X <- (X - min(X)) / (max(X) - min(X)) 


输出 X 的 值 : 


结果 如 下 : 


.5451726 


.6354409 


. 7718405 
. 9076216 


-6231765 


-6231765 
. 8041476 


. 3417331 
. 1980562 


. 1980562 
. 2830731 
. 3039392 


popppoppppo pppppppppp 9999999999 


[.1] 


6354409 
5937034 
5028951 
5988042 
5451726 


5937034 
5028951 
5988042 

[,13] 


7978590 


8041476 
7718405 
9076216 
7978590 


[,25] 
1446305 


2830731 
3039392 
1446305 
3417331 


归 一 化 Y 的 值 ， 


> Y <- 


输出 Y 的 值 : 


οσσσσσσσσς ὉΠΩΙΟΟΩΟΩΟΩΟΩΟΩ Dooooooococo 


[.2] 


. 5796069 


5307202 


. 5763600 
.6123338 
. 5487380 


5796069 


- 5307202 
. 5763600 
«6123338 
. 5487380 


[.14] 


. 8477304 
. 9449744 
. 8619244 
«7066160 
- 8540351 
. 8477304 
- 9449744 
. 8619244 
«7066160 
. 8540351 


[,26] 


.1855372 
. 3199320 
.2647339 


3072307 


. 3919639 
-1855372 
- 3199320 
. 2647339 
. 3072307 
. 3919639 


[.3] 

0. 5282779 
0. 5741530 
0. 7044705 
0. 6415219 
0.6882531 
0. 5282779 
0. 5741530 
0. 7044705 
0. 6415219 
0. 6882531 
[,15] 

0. 7924695 
0. 7725552 
0. 7800906 
0. 6909037 
0. 6815423 
0. 7924695 
0. 7725552 
0. 7800906 
0. 6909037 
0. 6815423 
[.27] 
0.1312774 
0.2515934 
0.2452782 
0. 2342600 
0.1635932 
0.1312774 
0.2515934 
0.2452782 
0. 2342600 
0.1635932 


[.4] 
0. 6387957 
0.7599904 
0.7500259 
0. 5883772 
0. 6303222 
0. 6387957 
0.7599904 
0.7500259 
0. 5883772 
0. 6303222 
[,16] 
0. 6970002 
0. 7559216 
0. 5694356 
0. 6063421 
0. 7974153 
0. 6970002 
0. 7559216 
0. 5694356 
0. 6063421 
0. 7974153 
[.28] 
0.09536614 
0.12841562 
0.02892975 
0.17771651 
0.19287067 
0.09536614 
0.12841562 
0.02892975 
0.17771651 
0.19287067 


结果 在 0 和 1 之 间 : 


> Υ 
结果 如 下 : 
[,1] [,2] [,3] 
[1,] 0.9938442 0.9755283 0.9455033 
[2,] 0.9938442 0.9755283 0.9455033 
[3,] 0.9938442 0.9755283 0.9455033 
[4,] 0.9938442 0.9755283 0.9455033 
[5,] 0.9938442 0.9755283 0.9455033 
[6,] 0.9938442 0.9755283 0.9455033 
[7,] 0.9938442 0.9755283 0.9455033 
[8,] 0.9938442 0.9755283 0.9455033 
[9,] 0.9938442 0.9755283 0.9455033 
[10,] 0.9938442 0.9755283 0.9455033 
[,14] [,15] [.16] 
[1,1 ο. 2061074 Ο. 1461466 0.0954915 
[2,1 0. 2061074 0.1464466 Ο. 0954915 
[3,1] 0. 2061074 0.1464466 0.0954915 
[4,] 0. 2061074 0.1464466 Ο. 0954915 
[5,1] 0. 2061074 0.1464466 Ο. 0954915 
[6.1 0. 2061074 0.1464466 Ο. 0954915 
[7,1 0. 2061074 0.1464466 0.0954915 
[8.1 0. 2061074 0.1464466 Ο. 0954915 
[9,1 0. 2061074 0.1464466 Ο. 0954915 
[10,1 0. 2061074 0.1464466 Ο. 0954915 
[,27] [,28] [,29] 
[1,1 0.2730048 0.3454915 0.4217828 
[2,] 0.2730048 0.3454915 0.4217828 
[3,] 0.2730048 0.3454915 0.4217828 
[4,] 0.2730048 0.3454915 0.4217828 
[5,] 0.2730048 0.3454915 0.4217828 
[6,] 0.2730048 0.3454915 0.4217828 
[7,] 0.2730048 0.3454915 0.4217828 
[8,] 0.2730048 0.3454915 0.4217828 
[9,] 0.2730048 0.3454915 0.4217828 
[10,] 0.2730048 0.3454915 0.4217328 
į sHs — rm. 
将 X 和 Y 进 行 转 置 : 


> X <- t(X) 
> Y <- t(Y) 


[4] 
. 9045085 
. 9045085 
. 9045085 
. 9045085 
. 9045085 
. 9045085 
. 9045085 
. 9045085 
. 9045085 
. 9045085 


0 
0 
0 
0 
0 
0 
0 
0 
0 
0 

[.17] 
0.05449674 
0. 05449674 
0.05449674 
0.05449674 
0.05449674 
0. 05449674 
0. 05449674 
0.05449674 
0.05449674 
0.05449674 


0. 


oooooocooco 


Ln Ln un uuu Ln n n 
ooooooooc 


5782172 
0.5782172 
.5782172 
- 5782172 
. 5782172 
5782172 
5782172 
- 5782172 
. 5782172 
- 5782172 


[,5] 
0. 7346948 
0. 6479934 
0. 7670115 
0. 7825188 
0. 6926913 
0. 7546948 
0. 6479934 
0. 7670115 
0.7825188 
0. 6926913 
[.17] 
0.5634776 
0.5679354 
0.5083825 
0.6860786 
0.6635038 
0.5634776 
0.5679354 
0. 5083825 
0. 6860786 
0. 6635038 
[,29] 
0.1481058 
0. 2042807 
0.2436258 
0.2697995 
0.2151497 
0.1481058 
0. 2042807 
0.2436258 
0. 2697995 
0. 2151497 


(Y - min(Y)) / (max(Y) 


[,5] 
. 8535534 
-8535534 
8535534 
-8535534 
-8535534 
. 8535534 
. 8535534 
. 8535534 
-8535534 
«8535534 


οσοσοσσσοσοος 


Ο. 0244717 
0. 0244717 
0. 0244717 
0. 0244717 
Ο. 0244717 
0. 0244717 
Ο. 0244717 
0. 0244717 
0. 0244717 
0. 0244717 
[.31] 

0.65 
0.65 
0.65 
0.65 
0.65 
0.65 
0.65 
0.65 
0.65 
0.65 


[,6] 

0. 7972073 
0. 7618196 
0. 77765825 
0. 6869214 
0.7069975 
0. 7972073 
0.7618196 
0.7776825 
0. 6869214 
0. 7069975 
[,18] 

0. 5786857 
0. 6402321 
0. 6706676 
0. 6565409 
0. 5690770 
0. 5786857 
0. 6402321 
0. 6706676 
0. 6565409 
0. 5690770 


[,7] 
0.6898536 
0. 8116367 
0. 8477539 
0. 8130090 
0. 8730621 
0. 6898536 
0. 8116367 
0. 8477539 
0. 8130090 
0. 8730621 

[,19] 
0. 6218280 
0. 45859864 
0. 5561135 
0. 5999989 
0. 6247283 
0. 6218280 
0.4889864 
0. 5561135 
0. 5999989 
0. 6247283 


[,30] 


[.8] 
0.7815417 
0.7868224 
1. 0000000 
0.7224553 
0.6881716 
0.7815417 
0.7868224 
1. 0000000 
0.7224553 
0.6881716 

[,20] 
0. 5315196 
0. 5152894 
0. 5944188 
0. 5714045 
0. 5370858 
0. 5315196 
0. 5152894 
0. 5944188 
0. 5714045 
0. 5370858 


[.31] 


[,9] 
0. 68715395 
0. 7673894 
0. 7245861 
ο. 7939027 
0. 8402071 
0. 6871595 
0.7673894 
0.7245861 
0.7939027 
0. 8402071 

[.21] 
0.3873829 
0.3331712 
0. 3733927 
0.2961664 
0.4737641 
0.3873829 
0.3331712 
0. 3733927 
0. 2961664 
0.4737641 


[,32] 


[ ,10] 
0. 8071538 
0. 8842260 
0. 8225836 
0.7268006 
0.7075135 
0. 8071538 
0. 8842260 
0. 8225836 
0.7268006 
0.7075135 

[,22] 
0. 2014617 
0. 3476343 
0.4216502 
0.2843159 
0.4405969 
0. 2014617 
0. 3476343 
0.4216502 
0. 2843159 
0.4405969 


[.33] 


[.11] 
0. 9178127 
0. 7908040 
0.7894753 
0. 9454927 
0.7285208 
0.9178127 
0.7908040 
0.7894753 
0.9454927 
0.7285208 

[,23] 
0. 2801250 
0. 2669833 
0.2492627 
0.1712096 
0.2221804 
0.2801250 
0. 2669833 
0. 2492627 
0.1712096 
0. 2221804 
[.34] 


[.12] 
0.8761765 
0.7840033 
0.7960983 
0.8658338 
0.7772329 
0.8761765 
0.7840033 
0.7960983 
0.8658338 
0.7772329 

[.24] 
0.1127961 
0.3206857 
0.3520874 
0.4162656 
0.2751527 
0.1127961 
0.3206857 
0. 3520874 
0.4162656 
0.2751527 


[,35] 


[,36] 


οσσσσσσσσο 


. 13109154 
. 04718597 
.24789822 


.15646443 
.13109154 
. 04718597 
.24789822 
.15991971 
.15646443 


7.508331e-17 
1.889101e-01 
4.848882e-02 
1.236458e-01 
1.662634e-01 
0. 000000e«00 
1.889101e-01 
4.848882e-02 
1.236458e-01 
1.662634e-01 


15991971 


.1625059 
. 0481722 
.2645255 
1479723 
.2532369 
1625059 
0481722 
. 2645255 
.1479723 
.2532369 


0. 2712798 
0.1007691 
0.1501646 
0. 2870491 
0.1318188 
0.2712798 
0.1007691 
0.1501646 
0. 2870491 
0.1318188 


0.2327581 
0.1986537 
0.1904320 
0.1440244 
0.1091675 
0.2327581 
0.1986537 
0.1904320 
0.1440244 
0.1091675 


.1349303 
.1256320 
.3297219 
.1783199 
.1274274 
.1349303 
.1256320 
3297219 
.1783199 
.1274274 


.17058057 
. 39106986 
.29845516 


09572346 


. 26543369 
.17058057 


39106986 


. 29845516 
.09572346 
. 26543369 


[.18] 


[,6] 
0.7938926 
0.7938926 
0.7938926 
0.7938926 
0.7938926 
0.7938926 
0.7938926 
0.7938926 
0.7938926 
0.7938926 


A 
4 
4 
4 
4 
4 
4 
4 
4 
4 0. 
[.32] 
45085 
45085 
45085 
45085 
45085 
45085 
45085 
45085 
45085 
45085 


0. 
0. 
0. 
0. 
0. 
0. 
0. 
0. 
0. 
0. 


0 
0 
0 
0 
ο. 
0 
0 
0 


7269952 
0.7269952 
.7269952 
- 7269952 
«7269952 
«7269952 
7269952 
«7269952 
. 7269952 
«7269952 


[.7] 
0. 7269952 
0. 7269952 
0.7269952 
0.7269952 
0.7269952 
0.7269952 
0.7269952 
0.7269952 
0.7269952 
0. 


cooocoocococooo 


[.33] 


σσσσσσσσσος 


0 
0 
0 
0. 
0 
0 
0 


0. 6545085 
0. 6545085 
7269952 0.6545085 

[.19] [.20] 
00615583 
00615583 
00615583 
00615583 
00615583 
00615583 
00615583 
00615583 
00615583 
00615583 


0. 00615583 
0. 00615583 
0. 00615583 
0.00615583 
0.00615583 
0. 00615583 
0.00615583 
0. 00615583 
0.00615583 
0.00615583 

[.34] 
./938926 
. 7938926 
- 7938926 
7938926 
7938926 
7938926 
7938926 
- 7938926 
. 7938926 
- 7938926 


— min(Y)) 


[,8] 
. 6545085 
. 6545085 
. 6545085 
6545085 
. 6545085 
. 6545085 
. 6545085 


[.21] 


Ο. 02447174 
Ο. 02447174 
Ο. 0244/7174 
Ο. 0244/7174 
Ο. 02447174 
Ο. 02447174 
Ο. 02447174 
Ο. 0244/7174 
Ο. 0244/7174 
Ο. 02447174 
[.35] 
0.8535534 
0. 8535534 
0.8535534 
0. 8535534 
0. 8535534 
0. 8535534 
0.8535534 
0. 8535534 
0. 8535534 
0.8535534 


[,9] [.10 
0. 5782172 
0. 5782172 
0. 5782172 
0. 5782172 
0. 5782172 
0. 5782172 
0. 5782172 
0. 5782172 
0. 5782172 
0. 5782172 


[.22] 


] [, 
5 
5 
5 
5 
5 
5 
5 
5 
5 
5 


0. 
0. 
0. 
0. 
0. 
0. 
0. 
0. 
0. 
0. 


[,23] 


0.05449674 
0.05449674 
0.05449674 
0.05449674 
0.05449674 
0.05449674 
0.05449674 
0.05449674 
0.05449674 
0.05449674 
[, 
0.9045085 
0.9045085 
0.9045085 
0.9045085 
0.9045085 
0.9045085 
0.9045085 
0.9045085 
0.9045085 
0.9045085 


36] [， 


0.4217828 
0.4217828 
0.4217828 
0.4217828 
0.4217828 
0.4217828 
0.4217828 
0.4217828 
0.4217828 
0.4217828 


0.9455033 
0.9455033 
0. 9455033 
0.9455033 
0. 9455033 
0. 9455033 
0.9455033 
0.9455033 
0. 9455033 
0.9455033 


11] 


[.24] 
0.0954915 
0.0954915 
0.0954915 
0.0954915 
0.0954915 
0.0954915 
0.0954915 
0.0954915 
0.0954915 
0.0954915 
37] 


[,12] 
0.3454915 0.2730048 
0.3454915 0.2730048 
0.3454915 0.2730048 
0.3454915 0.2730048 
0.3454915 0.2730048 
0. 3454915 
0.3454915 0.2730048 
0. 3454915 
0. 3454915 
0.3454915 0.2730048 


0.1464466 
0.1464466 
0.1464466 
0.1464466 
0.1464466 
0.1464466 
0.1464466 

[,38] 
0. 9755283 
0. 9755283 
0. 9755283 
0. 9755283 
0. 9755283 
0.9755283 
0. 9755283 
0. 9755283 
0. 9755283 
0. 9755283 


. 2061074 
. 2061074 
. 2061074 
. 2061074 
. 2061074 
. 2061074 
0. 

[,39] [.40] 
0. 9938442 
0. 9938442 
0. 9938442 
0. 9938442 
0. 9938442 
0. 9938442 
0. 9938442 
0. 9938442 
0. 9938442 
0. 9938442 


2061074 


|MPBHPHHHHHBHHH 


创建 训练 和 测试 数据 集 : 


> train <- 1:8 
> test «- 9:10 


YAJNA. Y-Y[train], AEH, X-X[train, ATWAA, learningrate-z0.05z&zr JST RR 
hidden dim=16 表 示 隐 藏 层 的 维度 ，numepochs=1500 表 示 整 个 数据 集训 练 的 次 数 。 
该 阶段 需要 一 些 时 间 ， 所 用 时 间 取 决 于 学 习 率 、 维 度数 量 以 及 整个 数据 集训 练 的 次 数 : 


> model <- trainr(Y = Y[train,],X = X[train,],learningrate = 
0.05,hidden dim = 16,numepochs = 1500) 


结果 如 下 : 
Trained epoch: 1310 - Learning rate: 0.05 
Epoch error: 0.660961658599474 
Trained epoch: 1311 - Learning rate: 0.05 
Epoch error: 0.669677942923603 
Trained epoch: 1312 - Learning rate: 0.05 
Epoch error: 0.790488223916989 
Trained epoch: 1313 - Learning rate: 0.05 
Epoch error: 0.604705780466322 
Trained epoch: 1314 - Learning rate: 0.05 
Epoch error: 0.736036716583117 
Trained epoch: 1315 - Learning rate: 0.05 
Epoch error: 0.846403635114378 
Trained epoch: 1316 - Learning rate: 0.05 
Epoch error: 0.705399512762672 
Trained epoch: 1317 - Learning rate: 0.05 
Epoch error: 0.655253881236524 
Trained epoch: 1318 - Learning rate: 0.05 
Epoch error: 0.683256850600975 
Trained epoch: 1319 - Learning rate: 0. 05 
Epoch error: 0.664219260959064 
Trained epoch: 1320 - Learning rate: 0.05 
Epoch error: 0.609030183713622 
Trained epoch: 1321 - Learning rate: 0.05 
Epoch error: 0.783214788737956 
Trained epoch: 1322 - Learning rate: 0.05 
Epoch error: 0.717855276763514 
Trained epoch: 1323 - Learning rate: 0. 05 
Epoch error: 0.648403367406859 
Trained epoch: 1324 - Learning rate: 0.05 
Epoch error: 0.665843170375635 
Trained epoch: 1325 - Learning rate: 0.05 
Epoch error: 0.716409342111275 
Trained epoch: 1326 - Learning rate: 0.05 
Epoch error: 0.616071661248296 
Trained epoch: 1327 - Learning rate: 0. 05 


Epoch error: 0.65502734088982 


预测 循环 神经 网 络 的 输出 : 


> Y predicted <- predictr (model, X) 


绘制 真实 值 与 预测 值 ， 输 出 包括 训练 数据 集 和 测试 数据 集 : 


> plot(as.vector(t(Y)), col = 'red', type = '1l', main = "Actual values 
vs Predicted values", ylab - "Y, Y-predicted") 


结果 如 下 : 
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> lines(as.vector(t(Y predicted)), type = 'l', col = 'blue") 
结果 如 下 : 
真实 值 与 预测 值 
-5 


0.2 
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绘制 真实 值 与 预测 值 ， 结 果 仪 包含 测试 数据 集 : 


> plot(as.vector(t(Y[test,])), col = 'red', type='l', main = "Actual vs 
predicted: testing set", ylab - "Y,Y-predicted") 


结果 如 下 : 


真实 值 与 预测 值 : 测试 集 
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> lines(as.vector(t(Y predicted[test,])), type = '1l', col 


'blue') 
结果 如 下 : 


真实 值 与 预测 值 : 测试 集 
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第 12 章 ”案例 研究 : 探索 世界 银行 数据 


12.1 引言 


世界 银行 指数 (World Bank Indicators, WDI) 是 世界 银行 汇总 制定 的 具有 国际 可 比 性 和 量化 的 天 于 全 球 整体 友 展 及 其 对 


人 们 生活 质量 影响 的 统计 指标 ， 它 通过 分 析 从 超过 200 个 国家 和 超过 50 个 国际 组 织 收集 来 的 超过 1400 个 指标 来 衡量 国家 、 地 区 
和 各 收入 群体 的 友 展 状况 。2015 年 9 月 25 日 ， 联 合 国 大 会 正式 通过 了 《可 持续 友 展 2030 议 程 》， 措 导 今 后 15 年 的 全 球 友 展 规 
R. SOG (联合 国 可 持续 发 展 目 标 ) 的 五 个 主要 主题 是 人 、 地 球 、 繁 荣 、 和 平和 伙伴 关系 。 参 与 的 国家 致力 于 结束 贫穷 和 饥 
俄 ， 确 保 所 有 人 都 能 企 有 尊严 的 、 和 平 的 、 健 康 的 环境 中 友 挥 他 们 的 潜力 ; 防止 地 球 的 环境 玉 化 并 对 气候 变化 采取 紧急 行动 ; Hü 
保 所 有 人 都 能 享受 到 繁 采 和 充实 的 生活 ， 保 持 人 与 自然 的 和 谐 健 康 友 展 ;建设 和 平 ， 人 公正, 包容， 免 于 芍 惧 和 暴力 的 社会 ， 并 通 
过 强大 的 全 球 伙伴 天 系 集中 针对 最 贫困 和 最 脆弱 的 地 区 动员 实施 “2030 议 程 ”。 从 世界 银行 的 角度 出 友 ， 针 对 SDG 的 17 个 目 
标 ， 来自 世 界 银行 的 友 展 数据 组 、 全 球 实践 和 跨 领 域 解决 方案 岛 域 的 专家 都 会 选择 多 个 指标 以 确定 和 分 析 当 前 的 重要 趋势 和 挑 
战 ， 并 丈 指 标 制定 的 问题 进行 讨论 。 世 界 友 展 指 标 是 许多 国际 机 构 、200 多 个 国家 统计 局 和 许多 其 他 机 构 合 作 的 结果 。 


第 12 章 ”案例 研究 : 探索 世界 银行 数据 


12.1 引言 


世界 银行 指数 (World Bank Indicators, WDI) 是 世界 银行 汇总 制定 的 具有 国际 可 比 性 和 量化 的 关于 全 球 整 体 友 展 及 其 对 
人 们 生活 质量 影响 的 统计 指标 ， 它 通过 分 析 从 超过 200 个 国家 和 超过 50 个 国际 组 织 收集 来 的 超过 1400 个 指标 来 衡量 国家 、 地 区 
和 各 收入 群体 的 友 展 状况 。2015 年 9 月 25 日 ， 联 合 国 大 会 正式 通过 了 《可 持续 友 展 2030 议 程 》， 措 导 今 后 15 年 的 全 球 友 展 规 
R. SOG (联合 国 可 持续 发 展 目标 ) 的 五 个 主要 主题 是 人 、 地 球 、 繁 荣 、 和 平和 伙伴 关系 。 参 与 的 国家 致力 于 结束 贫穷 和 饥 
俄 ， 确 保 所 有 人 都 能 企 有 尊严 的 、 和 平 的 、 健 康 的 环境 中 上 友 挥 他 们 的 潜力 ; 防止 地 球 的 环境 肪 化 并 对 气候 变化 采取 紧急 行动 ; ΠΗ͂ 
保 所 有 人 都 能 享受 到 繁 采 和 充实 的 生活 ， 保 持 人 与 自然 的 和 谐 健 康 友 展 ;建设 和 平 ， 人 公正, 包容， 免 于 芍 惧 和 暴力 的 社会 ， 并 通 
过 强大 的 全 球 伙伴 天 系 集中 针对 最 贫困 和 最 脆弱 的 地 区 动员 实施 “2030 议 程 ”。 从 世界 银行 的 角度 出 友 ， 针 对 SDG 的 17 个 目 
标 ， 来自 世 界 银 行 的 友 展 数据 组 、 全 球 实践 和 跨 领 域 解决 方案 岛 域 的 专家 都 会 选择 多 个 指标 以 确定 和 分 析 当 前 的 重要 趋势 和 挑 
战 ， 并 丈 指 标 制定 的 问题 进行 讨论 。 世 界 友 展 指 标 是 许多 国际 机 构 、200 多 个 国家 统计 局 和 许多 其 他 机 构 合 作 的 结果 。 


12.2 ”探索 世界 银行 数据 


2012 年 ， 世 界 上 有 13% 的 人 口 生 活 在 每 天 1.90 美 元 的 国际 贫困 线 以 下 ， 该 捐 标 低 于 1990 年 的 37%。 全 球 贫 困 率 的 下 降 有 助 
于 早日 实现 千年 友 展 目标 一 全 球 极 背 贫 困 人 口 减 半 。 其 目的 是 在 2030 年 年 底 前 消除 各 种 形式 的 贫困 ， 实 现 对 穷人 的 社会 保 
护 ， 增 加 基础 生活 服务 ， 并 帮助 文 持 受 武 半 冲突 和 和 气候 灾害 影响 的 人 们 。 





在 低 收 入 国家 ， 半 数 以 上 的 死亡 是 由 于 传染 病 、 孕 期 和 生育 问题 以 及 营养 状况 不 民 造 成 的 。 而 在 中 等 和 高 收入 国家 ， 超 过 三 
分 之 二 的 死亡 记录 是 由 非 传 染 性 疾病 引起 的 。 全 世界 1990 ~ 2013 年 能 源 使 用 增加 约 54%。 获 得 能 源 是 发 展 的 基础 ， 随 着 经 济 的 
友 展 ， 收 入 的 增加 和 人 口 的 增长 ， 人 们 需要 更 多 的 能 源 。 能 源 ， 尤 其 是 电力 ， 对 于 提高 中 低 收入 国家 人 民 的 生活 水 平公 天 重要 。 


准备 工作 


为 了 对 世界 银行 的 数据 进行 数据 模式 分 析 ， 我 们 将 使 用 下 面 的 数据 集 : 


. 世界 总 人 口 (1960—2015) 

: 所 有 的 国家 和 地 区 的 出 生 后 预期 寿命 (1960 一 2014) 

- 所 有 国家 和 地 区 的 生育 率 〈 每 名 妇女 的 生育 数量 ) (1960—2014) 

以 美元 计 的 所 有 国家 和 地 区 GDP (国内 生产 总 值 ) (1960—2015) 测量 
- 所 有 国家 和 地 区 的 贫困 人 口 比例 (1960—2016) 

- 所 有 国家 和 地 区 的 公共 卫生 状况 (1960--2016) 

- 所 有 国家 和 地 区 的 用 电 人 口 比 例 (1960—2016) 

: 所 有 国家 和 地 区 的 二 氧化 碳 排放 量 (1960--2016) 

第 1 步 : 收集 和 摘 述 数据 


用 于 分 析 的 世界 银行 数据 集 可 从 世界 银行 数据 银行 免费 下 载 获 取 。 


以 下 为 实现 细节 。 
第 2 步 : 下 载 数据 


载 入 如 下 软件 包 : 


> install.packages ("wbstats") 
> install.packages ("data.table") 
> install.packages ("googleVis") 


版 本 信息 : 本 节 的 代码 在 R 3.3.2 中 测试 (2016-05-03) ο 
需要 安装 如 下 库 : 
> library(wbstats) 


> library(data.table) 
> library(googleVis) 


下 载 数 据 并 理解 变量 之 间 的 关系 。 首 先 从 世界 银行 网 站 下 载 数据 。data.table () 水 数 允 许 大 数据 集 的 快速 聚合 ， 排 序 连 
接 ， 无 副本 的 分 组 添加 /修改 /删除 ， 列 出 数据 列 ， 友 好 的 文件 阅读 器 和 并 行文 件 写 入 等 操作 。wb () 函数 使 用 世界 银行 的 API 下 
载 数据 。indicator 表 示 指 标 代号 的 字符 向 量 。 


目标 代号 如 下 : 
: SP.POP.TOTL: 世界 总 人 口 (1960—2015) 


. SP.DYN.LEOO.IN: 所 有 国家 和 地 区 的 出 生 时 预期 寿命 (1960 一 2014) 


: SP.DYN.TFRT.IN: 所 有 国家 和 地 区 的 生育 率 (每 名 妇女 的 生育 数量 ) (1960—2014) 


结果 存储 在 Pop_LifeExp_FertRt 数 据 框 中 ， 使 用 如 下 命令 : 


> Pop LifeExp FertRt <- data.table(wb(indicator = c("SP.POP.TOTL", 
"SP.DYN.LEOO.IN", "SP.DYN.TFRT.IN"), startdate - 1960, enddate - 2016)) 


指标 代号 如 下 : 
: SP.POP.TOTL: 世界 总 人 口 (1960—2015) 
- NY.GDP.MKTP.CD-GDP: 以 美元 计 的 所 有 国家 和 地 区 GDP (1960—2015) 
- SLPOV.2DAY: 所 有 国家 和 地 区 的 贫困 人 口 比例 (1960—2016) 


结果 存储 在 Pop_GDPUSD_HeadCnt 数 据 框 中 。 使 用 如 下 命令 : 


> Pop GDPUSD HeadCnt «- data.table(wb(indicator = c("SP.POP.TOTL", 
"NY.GDP.MKTP.CD", "SI.POV.2DAY"), startdate - 1960, enddate - 2016)) 


指标 代号 如 下 : 

: SP.POP.TOTL: 世界 总 人 口 (1960—2015) 

: NY.GDP.MKTP.CD: 以 美元 计 的 所 有 国家 和 地 区 GDP (1960—2015) 
SH.STA.ACSN: 所 有 国家 和 地 区 的 公共 卫生 状况 (1960---2016) 


结果 存储 在 Pop_GDPUSD_Sanitation 数 据 框 中 ， 使 用 如 下 命令 : 


> Pop GDPUSD Sanitation <- data.table(wb(indicator = c("SP.POP.TOTL", 
"NY.GDP.MKTP.CD", "SH.STA.ACSN"), startdate - 1960, enddate - 2016)) 


指标 代码 如 下 : 
: NY.GDP.MKTP.CD: 所 有 国家 和 地 区 以 美元 计 的 GDP (1960—2015) 
- EG.ELC.ACCS.ZS: 所 有 国家 和 地 区 的 用 电 人 口 比例 (1960—2016) 
- EN.ATM.CO2E.KT: 所 有 国家 和 地 区 的 人 均 用 电量 (单位 KWh) (1960—2016) 


结果 存储 在 GDPUSD Electricity CO2 数 据 框 中 ， 使 用 如 下 命令 : 


> GDPUSD Electricity CO2 <- data.table(wb(indicator = 
c ("NY .GDP.MKTP .CD", "EG.ELC.ACCS.ZS", "EN.ATM.CC2E.KT"), startdate = 1960, 
enddate - 2016)) 


第 3 步 : 探索 数据 


探索 Pop LifeExp FertRt 数 据 框 的 维度 。dim () 函数 返回 Pop LifeExp FertRt 数 据 框 的 维度 。Pop LifeExp FertRt 数 据 框 


作为 输入 变量 传 入 。 结 果 清 楚 地 显示 了 该 数据 框 有 41150 行 数据 和 6 列 : 


> dim(Pop LifeExp FertRt) 


结果 如 下 : 
[1] 41150 6 
探索 Pop_GDPUSD_HeadCnt 数 据 框 的 维度 。 结 果 清楚 地 显示 了 该 数据 框 有 27023 行 数据 和 6 列 : 
> dim(Pop GDPUSD HeadCnt) 
结果 如 下 : 
[1] 27023 6 
探索 Pop_GDPUSD_Sanitation 数 据 框 的 维度 。 结 果 清 楚 地 显示 了 该 数据 框 有 31884 行 数据 和 6 列 : 
> dim(Pop GDPUSD Sanitation) 
结果 如 下 : 
[1] 31884 6 
探索 GDPUSD Electricity CO2 数 据 框 的 维度 。 结 果 清 楚 地 显示 了 该 数据 框 有 23994 行 数据 和 6 列 : 
> dim(GDPUSD Electricity CO2) 
结果 如 下 : 


[1] 23994 6 


探索 Pop LifeExp FertRt 数 据 框 的 内 部 结构 。str () 函数 显示 了 数据 框 的 内 部 结构 。Pop LifeExp_FertRt 作 为 R 对 象 传 入 
str () RAŽ: 


» str(Pop LifeExp FertRt) 


结果 如 下 : 
Classes 'data.table' and 'data.frame': 41150 obs. of 6 variables: 
$ value : num 3.92e-«08 3.84e4-08 3.//e-08 3.69e«-08 3.61e-«08 ... 
$ date : chr "2015" "2014" "2013" "2012" ... 
$ indicatorID: chr  "SP.POP.TOTL" "SP.POP.TOTL" "SP.POP.TOTL" "SP.POP.TOTL" ... 
$ indicator : chr "Population, total" "Population, total" "Population, total" "Population, total" 
$ iso2c "σπα ΙΝ TIA ΝΤ AN Wu 
$ country : chr "Arab world" "Arab world" "Arab world" "Arab world" ... 


attr(*, ".internal.selfref")-«externalptr- 


探索 Pop GDPUSD HeadCnt 数 据 框 的 内 部 结构 : 


> str(Pop GDPUSD HeadCnt) 


结果 如 下 : 
Classes 'data.table' and 'data.frame': 27023 obs. of 6 variables: 
$ value : num 392608 3.84e«-08 3.77e+08 3.69e«-08 3.61e-«-08 ... 
$ date : chr "2015" "2014" "2013" "2012" ... 
$ indicatorID: chr  "5P.POP.TOTL" "SP.POP.TOTL" "SP.POP.TOTL" "SP.POP.TOTL" . 
$ indicator : chr "Population, total" "Population, total" "Population, total" "Population, total" ... 
$ iso2c : chr "14A" "1A" "lA" "1A" 
$ country : chr "Arab world" "Arab wor 1d" "Arab world" "Arab world" ... 


attr(*, ".internal.selfref")-«externalptr- 


探索 Pop GDPUSD Sanitation 数 据 框 的 内 部 结构 : 


> str(Pop GDPUSD Sanitation) 


结果 如 下 : 
Classes 'data.table' and 'data.frame': 31884 obs. of 6 variables: 
$ value : num 3.9208 3.84e408 3.77608 3.69e-08 3.6108 ... 
$ date : chr "2015" "2014" "2013" "2012" ... 
$ indicatorID: chr "SP.POP.TOTL" "SP.POP.TOTL" "SP.POP.TOTL" "SP.POP.TOTL" . 
$ indicator : chr "Population, total" "Population, total" "Population, total" "Population, total" ... 
$ iso2c : chr “iA™ CIA JA" XN ... 
$ country : chr "Arab world" "Arab world" "Arab world" "Arab world" ... 


attr(*, ".internal.selfref")-«externalptr- 


探索 GDPUSD Electricity CO2 数 据 框 的 内 部 结构 : 


> Str(GDPUSD Electricity 0602) 


结果 如 下 : 


Classes 'data.table' and 'data.frame': 23994 obs. of 6 variables: 


$ value : num 2.57/e412 2.89e412 2.83e412 2. 36112 2.50e«12 ... 

$ date : chr "2015" "2014" "2013" "2012" ... 

$ indicatorID: chr  "NY.GDP.MKTP.CD" "NY.GDP.MKTP.CD" "NY.GDP.MKTP.CD" "NY.GDP.MKTP.CD" ... 

$ indicator : chr “GDP (current US$)" “GDP (current US$)" "GDP (current US$)" "GDP (current US$)" .. 
$ iso2c : chr "14" "14" "1A" "14" ... 

$ country : chr "Arab world" "Arab world" "Arab world" "Arab world" ... 


attr(*, ".internal.selfref")-«externalptr- 


输出 Pop LifeExp FertRt 数 据 框 。head () 函数 返回 Pop LifeExp FertRt 数 据 框 的 头 部 数据 。Pop LifeExp FertRt 作 为 输 
入 变量 传 入 : 


> head(Pop LifeExp FertRt) 


结果 如 下 : 


value date indicatorID indicator iso2c country 
1: 392022276 2015 SP.POP.TOTL Population, total 1A Arab world 
2: 384222592 2014 5P.POP.TOTL Population, total 1A Arab world 


3: 376504253 2013 5P.POP.TOTL Population, total 1A Arab world 
4: 368802611 2012 SP.POP.TOTL Population, total 14A Arab world 
5: 361031820 2011 SP.POP.TOTL Population, total 1A Arab world 
6: 353112237 2010 SP.POP.TOTL Population, total 1A Arab world 


输出 Pop GDPUSD HeadCnt 数 据 框 : 


> head(Pop GDPUSD HeadCnt) 


结果 如 下 : 

value date indicatorID indicator iso2c country 
1: 392022276 2015 SP.POP.TOTL Population, total 1A Arab world 
2: 384222592 2014 SP.POP.TOTL Population, total 1A Arab world 
3: 376504253 2013 SP.POP.TOTL Population, total 1A Arab world 
4: 368802611 2012 SP.POP.TOTL Population, total 1A Arab world 
5: 361031820 2011 SP.POP.TOTL Population, total 1A Arab world 
6: 353112237 2010 SP.POP.TOTL Population, total 1A Arab world 


输出 Pop GDPUSD Sanitation 数 据 框 : 


> head(Pop GDPUSD Sanitation) 


结果 如 下 : 

value date indicatorID indicator iso2c country 
1: 392022276 2015 5Ρ.ΡΟΡ.ΤΟΤιΙ Population, total 1A Arab world 
2: 384222592 2014 5Ρ.ΡΟΡ.ΤΟΤιΙ Population, total 1A Arab world 
3: 376504253 2013 SP.POP.TOTL Population, total 1A Arab world 
4: 368802611 2012 5P.POP.TOTL Population, total 1A Arab world 
5: 361031820 2011 5P.POP.TOTL Population, total 1A Arab world 
6: 353112237 2010 SP.POP.TOTL Population, total 1A Arab world 


输出 GDPUSD Electricity CO2 数 据 框 : 


> head(GDPUSD Electricity CO2) 


结果 如 下 : 


Value 
. 565871e+12 
.889755e412 
. 830820e-412 
./33908e412 
.497297e+12 
.103839e+12 
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date 
2015 
2014 
2013 
2012 
2011 
2010 


探索 SP.POP.TOTL 数 据 框 的 维度 。 


NY 


NY. 
NY. 
NY. 
NY. 


NY 


dim () 尔 数 返回 了 SP.POP.TOTL 数 据 框 的 维度 。SP.POP.TOTL 被 当 作 输 
结果 清楚 地 显示 了 该 数据 框 有 14623 行 数据 和 6 列 |: 


indicatorID 


- GDP. 
(ΠΡ. 
GDP. 
GDP. 
GDP. 
- GDP. 


ΜΚΤΡ. 
MKTP. 
MKTP. 
MKTP. 
MKTP. 
MKTP. 


CD 


GDP 
GDP 
GDP 
GDP 
GDP 
GDP 


indicator iso2c 


(current 
(current 
(current 
(current 
(current 
(current 


> dim(wb(indicator = "SP.POP.TOTL")) 
结果 如 下 : 
[1] 14623 6 


探索 SP.DYN.LE00.IN 数 据 框 的 维度 : 


> dim(wb (indicator = 


结果 如 下 : 


[1] 13253 


探索 SP.DYN.TFRT.IN 数 据 框 的 维度 : 


> dim(wb(indicator = 


结果 如 下 : 


[1] 13274 


探索 NY.GDP.MKTP.CD 数 据 框 的 维度 : 


6 


> dim (wb (indicator 


结果 如 下 : 


[1] 11050 


6 


探索 SI.POV.2DAY 数 据 框 的 维度 : 


" SP.DYN.TFRT.IN ")) 


b 


US$) 
US$) 
US$) 
US$) 
US$) 
us$) 


1A 


country 


Arab 
Arab 
Arab 
Arab 
Arab 
Arab 


"SP.DYN.LEOO.IN")) 


" NY.GDP.MKTP .CD")) 


wor ld 
wor ld 
wor ld 
wor ld 
wor ld 
wor ld 


变量 传 入 。 


> dim(wb(indicator = " SI.POV.2DAY ")) 
结果 如 下 : 


[1] 1350 6 
探索 SH.STA.ACSN 数 据 框 的 维度 : 
> dim(wb(indicator = " SH.STA.ACSN ")) 


结果 如 下 : 
[1] 6211 6 
探索 EG.ELC.ACCS.ZS 数 据 框 的 维度 : 


> dim(wb(indicator = "EG.ELC.ACCS.ZS")) 


结果 如 下 : 


[1] 1032 6 


探索 EN.ATM.CO2E.KT 数 据 框 的 维度 : 


> dim(wb(indicator = "EN.ATM.CO2E.KT")) 
结果 如 下 : 
[1] 11912 b 


使 用 wbcountries () 函数 从 世界 银行 API 下 载 更 新 的 国家 和 地 区 数据 信息 : 


> Countries <- data.table(wbcountries()) 


输出 Countries 数 据 框 。head () BRZioER[BICountrieszZAGETEBS SEEDS : 


> head(Countries) 


结果 如 下 : 


iso3c iso2c country capital long lat regionID region adminID 


1: ABW AW Aruba Oranjestad -70.0167 12.5167 LCN Latin America & Caribbean NA 

2: AFG AF Afghanistan Kabul 69.1761 34.5228 SAS South Asia SAS 

3: AFR A9 Africa NA NA NA NA Aggregates NA 

4: AG AO Angola Luanda 13.242 -8.81155 SSF Sub-Saharan Africa SSA 

5: ALB AL Albania Tirane 19.8172 341.3317 ECS Europe & central Asia ECA 

6: AND AD Andorra Andorra la vella 1.5218 342.5075 ECS Europe & central Asia NA 
admin incomeID income lendingID lending 

15 ΝΑ HIC High income LNX Not classified 

2: South Asia LIC Low income IDX IDA 

FE NA NA Aggregates NA Aggregates 

4: Sub-Saharan Africa (excluding high income) UMC Upper middle income IBD IBRD 

5: Europe & Central Asia (excluding high income) uMC Upper middle income IBD IBRD 

6: NA HIC High income LNX Not classified 


第 4 步 : 构建 模型 


对 Pop LifeExp FertRt 数 据 表 进行 排序 : setkey () 函数 对 Pop LifeExp_FertRt 数 据 表 进行 排序 并 且 标 识 其 是 排序 后 的 结 
果 。 用 于 排序 的 列 是 主键 。 该 数据 的 主键 是 iso2c 列 。iso2c 列 以 升序 排序 。 该 表 使 用 引用 的 方式 改变 内 部 元 素 顺序 ， 因 此 内 存 消 
FERIR: 


> setkey (Pop LifeExp FertRt, iso2c) 


对 Pop GDPUSD HeadCnt 数 据 表 排 序 : 


> setkey(Pop GDPUSD HeadCnt, iso2c) 


对 Pop GDPUSD Sanitation 数 据 表 排序 : 


> setkey (Pop GDPUSD Sanitation, iso2c) 


对 GDPUSD Electricity CO2 数 据 表 排序 : 


> setkey(GDPUSD Electricity 0602, iso2c) 


对 Countries 数 据 表 排序 : 
> setkey(Countries, iso2c) 
输出 Countries 数 据 表 : 
> head(setkey(Countries, iso2c)) 


结果 如 下 : 


iso3c iso2c country capital long lat 


1: ARB 1A Arab world ΝΑ ΝΑ ΝΑ 
2: μι Ὁ 1" wor ld NA ΝΑ NA 
3: EAP 4E East Asia & Pacific (excluding high income) NA NA NA 
4: DXS 6D IDA total, excluding Sub-Saharan Africa NA ΝΑ NA 
下 FXS 6F IDA countries classified as fragile situations, excluding Sub-Saharan Africa NA ΝΑ ΝΑ 
6: Νι 5 ΘΙ. Non-resource rich sub-saharan Africa countries, of which landlocked ΝΑ ΝΑ NA 
regionID region adminID admin incomeID income lendingID lending 
.. ΝΑ Aggregates ΝΑ ΝΑ ΝΑ Aggregates NA Aggregates 
2: NA Aggregates NA NA NA Aggregates NA Aggregates 
3: NA Aggregates NA NA NA Aggregates NA Aggregates 
4: NA Aggregates NA NA NA Aggregates NA Aggregates 
5: NA Aggregates NA NA NA Aggregates NA Aggregates 
6: NA Aggregates NA NA NA Aggregates NA Aggregates 


为 Pop LifeExp FertRt 数 据 集 增加 region 列 并 移 除 aggregate 数 据 : 


> Pop LifeExp FertRt «- Countries[Pop LifeExp FertRt][ | 
"Aggregates"] 


region $in$ 


输出 Pop_LifeExp FertRt 数 据 表 : 


> head (Pop LifeExp FertRt) 


pb ΓΗ͂ rT 


结果 如 下 : 


Ce un £u n HP 
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iso3c iso2c 
AND 
AND 
AND 
AND 
AND 
AND 
income 
income 
income 
income 
income 
income 
income 


High 
High 
High 
High 
High 
High 


country 
Andorra 
Andorra 
Andorra 
Andorra 
Andorra 
Andorra 


Andorra 
Andorra 
Andorra 
Andorra 
Andorra 
Andorra 


lendingID 


LNX 


NOt 
Not 
NOt 
Not 
NOt 
Not 


capital 
vella 
vella 
vella 
vella 
vella 
vella 

lending 
classified 
classified 
classified 
classified 
classified 
classified 


long 
1.5218 
1.5218 
1.5218 
1.5218 
1.5218 
1.5218 
value date 
/0473 2015 
72786 2014 
75902 2013 
79316 2012 
82326 2011 
84419 2010 


. 5075 


lat regionID 
ECS 
ECS 
ECS 
ECS 
ECS 
ECS 
indicatorID 
» TOTL 
-TOTL 
» TOTL 
«ΤΟΤΙ 
. TOTL 
«ΤΟΤΙ 


region adminID admin incomeID 


Europe & Central Asia NA NA HIC 

Europe & central Asia NA NA HIC 

Europe & Central Asia NA NA HIC 

Europe & central Asia NA NA HIC 

Europe & Central Asia NA NA HIC 

Europe & central Asia NA NA HIC 
indicator i.country 

Population, total Andorra 

Population, total Andorra 

Population, total Andorra 

Population, total Andorra 

Population, total Andorra 

Population, total Andorra 


Te «Pop GDPUSD HeadCnt 数 据 集中 的 regions 列 是 aggregates 的 数据 : 


"Aggregates"] 


> Pop GDPUSD HeadCnt <- Countries[Pop GDPUSD HeadCnt][ ! 


region $in$ 


移 除 Pop GDPUSD Sanitation 数 据 集中 的 regions 列 是 aggregates 的 数据 : 


> Pop GDPUSD Sanitation <- Countries[Pop GDPUSD Sanitation][ ! 


$in$ "Aggregates"] 


region 


Te RGDPUSD Electricity CO2 数 据 集 中 的 regions 列 是 aggregates 的 数据 : 


$in$ 


region, 
"countrv", 


region, 
"Count ie, 


list (country, 
idvar=c("date", 


> GDPUSD Electricity CO2 <- Countries[GDPUSD Electricity CO2][ ! 
"Aggregates"] 


> wPop LifeExp FertRt <- reshape(Pop LifeExp FertRt[, 
indicator)], 
timevar-"indicator", 


> wPop GDPUSD HeadCnt <- reshape(Pop GDPUSD HeadCnt[, 
indicator)], 
timevar-" indicator", 


date, 


date, 


value, 
"region"), 


value, 
"region"), 


region 


list (country, 
"value", idvar=c ("date", 
direction = "wide") 


v.names = 


list (country, 
"value", idvar-c("date", 
direction = "wide") 


v.names = 


> wPop GDPUSD Sanitation <- reshape (Pop GDPUSD Sanitation[, 


"wide" ) 


list (country, 


idvar-c("date", 


region, 
"CGOountrs"”, 


date, 


"value", 
direction - 


value, indicator)], v.names - 
"region"), timevar-"indicator'", 


> wGDPUSD Electricity CO2 «- reshape(GDPUSD Electricity CO2[, 


"wide") 


region, 


"nt er, 


date, 


value, indicator)], v.names = "value", 


"region"), timevar-"indicator", direction 


输出 wPop LifeExp FertRt 数 据 框 的 内 容 : 


> wPop LifeExp FertRt 


结果 如 下 : 
country region date value.Population, total value.Fertility rate, total (births per woman) 
1: Andorra Europe & Central Asia 2015 70473 NA 
2: Andorra Europe & central Asia 2014 72786 NA 
3: Andorra Europe & central Asia 2013 75902 NA 
4: Andorra Europe & central Asia 2012 79316 NA 
5: Andorra Europe & Central Asia 2011 82326 NA 
12053: Zimbabwe _ Sub-Saharan Africa 1964 4279561 7.347 
12054: Zimbabwe _ Sub-Saharan Africa 1963 4140804 7.311 
12055: Zimbabwe ` Sub-Saharan Africa 1962 4006262 7.267 
12056: Zimbabwe _ Sub-Saharan Africa 1961 3876638 7.215 
12057: Zimbabwe sub-saharan Africa 1960 3752390 7.158 
value.Life expectancy at birth, total (years) 
1: ΝΑ 
2: ΝΑ 
3: ΝΑ 
4: NA 
5: NA 
12053 52.97166 
12054 52.62932 
12055 52.27790 
12056 51.91495 
12057 51. 54246 


输出 wGDPUSD Electricity CO2 数 据 框 的 内 容 : 


> wGDPUSD Electricity CO2 


结果 如 下 : 


country region date value.GDP (current US$) value.Access to electricity (X of population) value.CO2 emissions (kt) 


1: Andorra Europe & Central Asia 2013 3248924588 NA 491.378 
2: Andorra Europe & Central Asia 2012 3146151869 100 491.378 
3: Andorra Europe & central Asia 2011 3427022519 NA 491.378 
4: Andorra Europe & central Asia 2010 3346516556 100 517.047 
5: Andorra Europe & Central Asia 2009 3650083356 NA 517.047 
10483: Zimbabwe Sub-Saharan Africa 1964 1217138000 NA 4473.740 
10484: zimbabwe _ Sub-Saharan Africa 1963 1159511700 NA NA 
10485: Zimbabwe _ Sub-Saharan Africa 1962 1117601600 NA NA 
10486: zimbabwe _ Sub-Saharan Africa 1961 1096646600 NA NA 
10487: Zimbabwe ^ Sub-Saharan Africa 1960 1052990400 NA NA 


转换 wPop LifeExp FertRt, wPop GDPUSD HeadCnt, wPop GDPUSD Sanitationf[]wWGDPUSD Electricity CO2 数 据 
集 从 字符 形式 到 整 型 形式 : 


wPop LifeExp FertRt[, date := as.integer (date)] 
wPop GDPUSD HeadCnt[, date :- as.integer (date)] 
wPop GDPUSD Sanitation[, date := as.integer (date)] 
wGDPUSD Electricity CO2[, date :- as.integer(date)] 


V V V V 


设置 名 称 。setnames () 函数 设置 wPop LifeExp FertRt, wPop GDPUSD HeadCnt, wPop GDPUSD Sanitation 和 
wGDPUSD Electricity CO2 对 象 的 名 字 : 


> setnames(wPop LifeExp FertRt, names(wPop LifeExp FertRt), 
c("Country", "Region", "Year", "Population", "Fertility", 


"LifeExpectancy")) 

> setnames(wPop GDPUSD HeadCnt, names (wPop GDPUSD HeadCnt), 
c("Country", "Region", "Year", "Population", "GDPUSD", "PovertyHead")) 

> setnames(wPop GDPUSD Sanitation, names(wPop GDPUSD Sanitation), 
c("Country", "Region", "Year", "Population", "GDPUSD", "SanitationAccess")) 

> setnames(wGDPUSD Electricity CO2, names (wGDPUSD Electricity CO2), 
c("Country", "Region", "Year", "GDPUSD", "ElectricityConsumption", 
"CO2Emissions")) 


第 5 步 : 绘制 模型 


使 用 如 下 步骤 绘制 wPop LifeExp FertRt 数 据 框 模型 。gvisMotionChart () 函数 读 入 wPop LifeExp FertRt 数 据 框 。 它 使 
用 Google 可 视 化 API 创 建 包含 在 网 页 中 的 图 表 输 出 。 图 表 使 用 浏 贞 器 中 的 Flash 进 行 泻 染 。 动 态 的 图 表 可 以 非 音 直观 地 对 指标 进 
行 探索 。wPop _LifeExp FertRt 是 数据 框 。idvar="Country" 代 表 了 数据 框 中 被 分 析 的 列 名 。xvar="LifeExpectancy" 是 绘制 在 x 
轴 上 的 数值 向 量 。yvar="Fertility" 是 绘制 在 y 轴 上 的 数值 向 量 。sizevar="Population" 代 表 要 绘制 到 图 表 上 的 列 的 数值 。 
colorvar= "Region "是 图 表 中 气泡 的 对 应 值 。 使 用 如 下 命令 : 


> pltPop LifeExp FertRt «- gvisMotionChart (wPop LifeExp FertRt, idvar = 
"Country", timevar - "Year", xvar - "LifeExpectancy", yvar - "Fertility", 
sizevar - "Population", colorvar - "Region") 

» plot(pltPop LifeExp FertRt) 


绘制 wPop GDPUSD HeadCnt 数 据 框 模型 : 


> pltPop GDPUSD HeadCnt «- gvisMotionChart (wPop GDPUSD HeadCnt, idvar = 
"Country", timevar = "Year", xvar = "GDPUSD", yvar = "PovertyHead", sizevar 
= "Population", colorvar = "Region") 

> plot(pltPop GDPUSD HeadCnt) 


绘制 wPop GDPUSD Sanitation 数 据 框 模型 : 


> pltPop GDPUSD Sanitation «- gvisMotionChart (wPop GDPUSD Sanitation, 
idvar - "Country", timevar - "Year", xvar - "GDPUSD", yvar - 
"SanitationAccess", sizevar = "Population", colorvar = "Region") 

» plot(pltPop GDPUSD Sanitation) 


绘制 pltGDPUSD Electricity CO2 数 据 框 模型 : 


> pltGDPUSD Electricity 602 <- gvisMotionChart (WwGDPUSD Electricity CO2, 
idvar = "Country", timevar = "Year", xvar = '"GDPUSD'", yvar = 
"ElectricityAccess", sizevar - "CO2Emissions", colorvar - "Region") 

» plot(pltGDPUSD Electricity CO2) 


结果 如 下 ， 人 生育 率 与 预期 寿命 : 
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Data: wPop LifeExp FertRt* Chart ID: MotionChartlD80c4e7660fa * googleVis-0.6.1 
R version 3.3.2 (2016-10-31) * Google Terms of Use * Documentation and Data Policy 


人 口 增长 : 
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Data: wPop LifeExp FertRt * Chart ID: MotionChartlD80c4e7660fa * googleVis-0.6.1 
R version 3.3.2 (2016-10-31) * Google Terms of Use * Documentation and Data Policy 


以 美元 计 的 GDP 增 长 : 
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Data: wPop GDPUSD HeadCnt* Chart ID: MotionChartlID80c38fb2c06 » googleVis-0.6.1 
R version 3.3.2 (2016-10-31) * Google Terms of Use * Documentation and Data Policy 


贫困 率 与 人 口 增长 : 
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Data: wPop GDPUSD HeadCnt * Chart ID: MotionChartlID80c38f52c06 » googleVis-0 6.1 
R version 3.3.2 (2016-10-31) * Google Terms of Use * Documentation and Data Policy 


享有 公共 卫生 服务 的 人 口 增长 : 
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Data: wPop GDPUSD Sanitation * Chart ID: MotionChartlD80c4d6c13c1 * googleVis-0.6.1 
R version 3.3.2 (2016-10-31) * Google Terms of Use * Documentation and Data Policy 


公共 卫生 服务 访问 量 : 
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Data: wPop_ GDPUSD Sanitation * Chart ID: MotionChartID80c4d6c13c1 * googleVis-0.6.1 
R version 3.3.2 (2016-10-31) * Google Terms of Use * Documentation and Data Policy 


公共 卫生 状况 改进 与 人 口 增长 : 
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Data: wPop GDPUSD Sanitation * Chart ID: MotionChartlD80c4d6c13c1 * googleVis-0.6.1 


R version 3.3.2 (2016-10-31) * Google Terms of Use * Documentation and Data Policy 


全 部 国家 和 地 区 的 用 电 人 口 变 化 : 
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Data: wGDPUSD Electricity CO2 * Chart ID: MotionChartiD80c568c3248 + googleVis-0.6.1 
R version 3.3.2 (2016-10-31) * Google Terms of Use * Documentation and Data Policy 


CO2 排 放量 (对 数 尺度 ) : 
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Data: wGDPUSD Electricity CO2 * Chart ID: MotionChartiD80c568c3248 * googleVis-0 6.1 
R version 3.3.2 (2016-10-31) * Google Terms of Use * Documentation and Data Policy 
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Data: wGDPUSD Electricity CO2 * Chart ID: MotionChartiD80c568c3248 » googleVis-0.6.1 
R version 3.3 2 (2016-10-31) * Google Terms of Use * Documentation and Data Policy 


13.1 


顾名思义 ， 再 保险 由 保险 业务 友 展 而 来 ， 其 使 用 沁 围 不 仅 取 决 于 金额 ，j 
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Data: wGDPUSD Electricity CO2 * Chart ID: MotonmcharD80c568c3248 + googleVis-0.6.1 
R version 3.3.2 (2016-10-31) * Google Terms of Use * Documentation and Data Policy 


引言 


98138 


候 ， 可 处 理 的 再 保险 业务 量 主要 取决 于 可 用 的 直接 业务 量 。 再 保险 的 思想 


人 分 担 。 


98138 


RIAR: 再 保险 合同 定价 


还 取决 于 直接 保险 公司 承销 的 风险 特征 。 在 任何 时 
植 根 于 人 类 避免 风险 的 本 能 ， 即 一 个 人 的 损失 将 被 许多 


RIAR: 再 保险 合同 定价 


13.31 引言 


μεν, PIDRESEHURESMEAS RRM, ἘΕΗΗΙΡΒΙ ΚΕΑ ΓΕ, YRRUAG EGEURESZSRDEÉSBUUSSRRUE. EE 
候 ， 可 处 理 的 出 保险 业务 量 主 要 取决 于 可 用 的 直接 业务 量 。 再 保险 的 思想 植 根 于 人 类 避免 风险 的 本 能 ， 即 一 个 人 的 损失 将 被 许多 
人 分 担 。 


13.2 下 保险 合同 定价 


保险 公司 安排 再 保险 的 主要 目标 包括 ; 增加 承担 更 大 的 风险 的 能 力 ， 包 括 由 于 经 济 上 的 限制 而 向 保险 公司 传递 通常 不 承担 的 
部 分 风险 ; 提高 接受 大 于 人 资 本 可 接受 学 围 的 业务 线 的 能 力 ;， 在 再 保险 公司 吸收 更 大 的 索赔 或 灾难 损失 的 情况 下 稳定 每 年 的 经 营业 
绩 ;， 通 过 加 强 承 销 商 建立 规模 和 风险 质量 均一 的 账 尸 ， 增 加 赚 取 利润 的 机 会 ， 写 入 能 力 和 新 的 风险 北口 。 骨 保险 的 功能 可 以 视 为 
提供 服务 ， 以 保护 增加 的 能 力 ， 财 务 稳定 性 ， 过 赔 比 例 稳 定性 ， 不 同类 别 的 过 赔 积 暴 ， 风 险 曼 延 ， 保 障 偿付 能 力 利润 和 稳定 利 
润 。 再 保险 有 助 于 吸收 经 济 变化 、 社 会 变化 、 保 险 方式 变化 和 科学 友 展 所 市 来 的 变化 等 新 风险 。 


只 有 两 种 安排 再 保险 合同 的 方式 : 单一 政策 的 一 次 性 兼职 再 保险 ， 或 者 定义 的 一 组 政策 的 目 动 条 约 骨 保险 。 


准备 工作 


我 们 使 用 Hurricane 数 据 集 计 算 再 保险 合同 的 定价 。 
第 1 步 : 收集 和 摘 述 数据 
选用 的 数据 集 publicdatamay2007.xls 是 一 种 XLS 格式 标准 数据 集 ， 人 存储 207 行 数据 和 7 种 变量 ， 其 中 数值 型 变量 包括 : 
”Ye 
- Base economic damage 
: Normalized PL05 
: Normalized (105 
非 数值 型 变量 包括 : 
- Hurricane description 
: State 


: Category 


具体 实施 步骤 


以 下 为 实现 细节 。 


第 2 步 : 探索 数据 


加 载 以 下 程序 包 : 


install.packages("gdata") 
install.packages("evir") 
library (gdata) 
library (evir) 


V V V V 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.3.2。 


现在 开始 探索 数据 并 理解 参数 之 间 的 关系 。 我 们 导入 publicdatamay2007.xls 数 据 集 并 保存 为 StormDamageData 数 据 框 : 


> StormDamageData <- read.xls("d:/publicdatamay2007.xls", sheet = 1) 


输出 StormDamageData 数 据 框 。 使 用 函数 head () 返回 StormDamageData 数 据 框 的 头 部 数据 ，StormDamageData 作 
为 国 数 的 输入 参数 : 


> head(StormDamageData) 


结果 如 下 : 

Year Hurricane. Description State Category Base.Economic.Damage Normalized.PLO5 Normalized.CLO5 X x.1 
1 1900 Galveston (1) TX 4 30,000,000 77,961,217,075 71,883,312,422 NA NA 
2 1901 4 LA,M5 1 1,000,000 160,419,111 194,228,565 NA NA 
3 1903 3 FL 1 700,000 — 5,233,590,783 4,205,750,228 NA ΝΑ 
4 1904 2 SC 1 2,000,000 884,746,945  À1,521,808,490 ΝΑ ΝΑ 
5 1906 5 AL,M5 2 4,000,000 1,781,764,478 2,013,732,631 NA NA 
6 1906 8 FL 3 200,000 1,449,580,271 1,180,430,7/4 NA ΝΑ 


使 用 函数 tail () 返回 StormDamageData 数 据 框 的 尾部 数据 ，stormDamageData 作 为 亢 数 的 输入 参数 : 


> tail(StormDamageData) 


结果 如 下 : 

Year Hurricane. Description State Category Base.Economic.Damage Normalized.PLO5 Normalized.CLO5 X x.1 
202 2005 cindy LA 1 320,000,000 320,000,000 320,000,000 NA NA 
203 2005 Dennis FL 3 2,230,000,000 2,230,000,000 2,230,000,000 NA NA 
204 2005 Katrina LA,MS 3 81,000,000,000 381,000,000,000 381,000,000,000 NA ΝΑ 
205 2005 ophelia NC 1 1,600,000,000  1,600,000,000  À 1,600,000,000 NA ΝΑ 
206 2005 Rita TX 3 10,000,000,000 10,000,000,000 10,000,000,000 NA ΝΑ 
207 2005 wilma FL 3 20,600,000,000 20,600,000,000 20,600,000,000 NA ΝΑ 


探索 StormDamageData 数 据 框 的 维度 。 使 用 dim () 函数 返回 StormDamageData 数 据 框 的 维度 ，StormDamageData 
作为 函数 的 输入 参数 。 返 回 结果 清楚 地 显示 数据 框 有 207 行 数据 和 9 绚 : 


> dim(StormDamageData) 


结果 如 下 : 


[1] 207 9 


第 3 步 : YLPELT AGRAR 


faxum. CuEBRZXChangeFormat/AfexeB [Brig S (, ) ， 并 将 结果 作为 数值 返回 : 


> ChangeFormat <- function(x)( 
x = as.character (x) 
for(i in 1:10) í(x-sub(",","",as.character(x))) 
return(as.numeric(x)) ) 


将 数据 框 StormDamageData 存 入 base 中 : 


> base «- StormDamageData[,1:4] 


VgFHt3&pRZ4XChangeFormat, Z&igtStormDamageDatarRBSBase.Economic.Damage7358N 2X, Až Vectorize () 
创建 函数 ChangeFormat () 的 包装 。 结 果 保 存在 数据 框 base$Base.Economic.Damage 中 : 


> base$Base.Economic.Damage «- 
Vectorize (ChangeFormat) (StormDamageData$Base.Economic.Damage) 


调用 包装 函数 ChangeFormat。 数 据 框 StormDamageData 中 的 Normalized.PL05 为 输入 参数 。 结 果 保 存在 数据 框 
base$Normalized.PLO5 中 : 


> base$Normalized.PLOS <- 
Vectorize(ChangeFormat) (StormDamageData$Normalized.PL05) 


调用 包装 函数 ChangeFormat。 数 据 框 StormDamageData 中 的 Normalized.CL05 为 输入 参数 。 结 果 保 存在 数据 框 
base$Normalized.CLO5 中 : 


> base$Normalized.CLO5 <- 
Vectorize (ChangeFormat) (StormDamageData$Normalized.CL05) 


输出 base 数 据 框 。 使 用 函数 head () 返回 base 数 据 框 的 头 部 数据 ，base 作 为 函数 的 输入 参数 : 


> head (base) 


结果 如 下 : 

Year Hurricane. Description State Category Base.Economic.Damage Normalized.PLO5 Normalized.CL05 
1 1900 Galveston (1) TX 4 36.07 77961217075 71883312422 
2 1901 4 LA,MS 1 le+06 160419111 194228565 
3 1903 3 FL 1 7e-05 5233590783 4205750228 
4 1904 2 SC 1 2606 884746945 1521808490 
5 1906 5 AL ,MS 2 4e+06 1781764478 2013732631 
6 1906 8 FL 3 26105 1449580271 1180430774 


REIER REKRIRA. plot () 为 绘制 R 对 象 的 通用 函数 。base$Normalized.PL05/1e9 代 表 绘 制 的 x 轴 
type= "h "代表 直方 图 模式 ; ylim=c (0, 155) 设置 y 轴 的 限制 ， 下 限 为 0， 上 限 为 155; x 轴 代表 飓风 损失 的 编号 : 


> plot(base$Normalized.PL05/1e9, type-"h", ylim-c(0,155), main = "207 
Hurricanes, Normalized Costs: 1900 - 2005", xlab - "Index of Loss", ylab - 
"Normalized Costs", col = "red") 


结果 如 下 : 


1900 ~ 2005 年 的 207 次 刚 风 造成 的 归 一 化 损失 
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第 4 步 : 计算 由 风 的 数量 


提取 每 年 的 艰 风 计数 的 年 份 和 频率 。 数 据 框 base 包 含 前 面 的 文本 所 示 的 详细 信息 。table () 使 用 base$Year 来 构建 每 年 由 
风 计 数 的 应 急 表 。 结 果 和 存储 在 数据 框 TestBase 中 : 


> TestBase <- table (base$Year) 


输出 TestBase 数 据 框 的 内 容 : 
> TestBase 


结果 如 下 : 


1900 1901 1903 1904 1906 1909 1910 1911 1913 1915 1016 1918 1919 1920 1921 1926 1928 1929 1932 1933 1934 1935 1936 1938 1940 1941 1942 
1 1 1 1 2 3 1 1 1 2 2 1 1 1 1 3 1 2 1 4 3 2 3 2 2 2 2 


1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 


1 3 1 
1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 
1 5 3 


1997 1998 1999 2000 2001 2002 2003 2004 2005 
5 2 3 6 3 6 6 


从 TestData 数 据 框 中 提取 年 份 。 函 数 names () JIEHEEHERIJG4 SF, EKZNas.numeric () 将 提取 的 每 年 的 名 字 转 换 为 数值 变 
量 ， 结 果 保 存在 years 数 据 框 中 : 


> years <- as.numeric(names (TestBase) ) 


输出 数据 框 years 的 内 容 : 


> years 


结果 如 下 : 


[1] 1900 1901 1903 1904 1906 1909 1910 1911 1913 1915 1916 1918 1919 1920 1921 1926 1928 1929 1932 1933 1934 1935 1936 1938 1940 1941 
[27] 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 
[53] 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 
[79] 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 


从 数据 框 TestData 中 提取 刚 风 计数 的 频率 。 函 数 names () EREEREER, Büflas.numeric () 将 提取 的 每 年 
的 隐 风 计数 的 名 字 转 换 为 数值 变量 ， 结 果 保存 在 frequency 数 据 框 中 : 


> frequency «- as.numeric(TestBase) 


输出 数据 框 frequency 的 内 容 : 


> frequency 


结果 如 下 : 


[1] 1900 1901 1903 1904 1906 1909 1910 1911 1913 1915 1916 1918 1919 1920 1921 1926 1928 1929 1932 1933 1934 1935 1936 1938 1940 1941 
[27] 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 
[53] 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 
[79] 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 


从 数据 框 TestBase 中 提取 每 年 无 则 风 事 件 的 飓风 次 数 ， 绪 果 保 仔 在 数据 框 years0frequency 中 : 


> yearsOfrequency «- (1900:2005) [which (! (1900:2005) Sin%years)] 


输出 数据 框 years0frequency 的 内 容 : 


> years0frequency 


结果 如 下 : 


[1] 1902 1905 1907 1908 1912 1914 1917 1922 1923 1924 1925 1927 1930 1931 1937 1939 


提取 每 年 所 有 了 恨 风 的 数量 。 结 果 保 存在 数据 框 StormDamageData 中 : 


> StormDamageData <- data.frame(years-c(years, yearsOfrequency), 
frequency=c (frequency, rep(0,length(yearsOfrequency)))) 


输出 StormDamageData 数 据 框 。 使 用 函数 head () 返回 stormDamageData 数 据 框 的 头 部 数据 部 
分 ，stormDamageData 作 为 函数 的 输入 参数: 


> head(StormDamageData) 


结果 如 下 : 

years frequency 
1 1900 1 
2 1901 1 
3 1903 1 
4 1904 1 
5 1906 2 
6 1909 3 


绘制 1900 ~ 2005*ERBXLE ERR TETUR, plot () 为 绘制 R 对 象 的 通用 函数 。years 代 表 绘 制 的 x 轴 ; frequency 代 表 绘 制 
的 y 轴 ; type= "h" 代 表 直 方 图 模式 : 


> plot (years, frequency, type-"h", main = "Frequency of Hurricanes: 
1900 - 2005", xlab = "Time (Years)", ylab = "Annual Frequency", col = 
" red" ) 
结果 如 下 : 
1900 ~ 2005 年 的 飓风 频率 


年 度 频率 
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计算 1900 ~ 2005 年 飓风 计数 的 均值 


> mean(StormDamageData$frequency) 


结果 如 下 : 


[1] 1.95283 


每 年 平均 上 帮 生 大 约 2 次 飓风 。 
第 5 步 : 构建 预测 模型 


我 们 来 看 一 下 限 风 发生 频率 的 可 能 线性 趋势 。 消 数 glm () 用 来 拟 合 广义 线性 模型 。frequency ~ years 定 义 公 
式 ，data=StormDamageData 定 义 公 式 的 数据 集 ， 吵 数 family=poisson (link="identity") 代表 泪 松 分 布 。 


浮 数 Im () 用 来 拟 合 线性 模型 。frequency ~ years 定 义 公 式 ，data=StormDamageData 定 义 公 式 的 数据 集 。 使 用 以 下 命 


> LinearTrend «- glm(frequency-years, data = StormDamageData, 
family-poisson(link-z"identity"), start-lm(frequency-years, data = 
StormDamageData)S$coefficients) 


输出 LinearTrend 内 容 : 


> LinearTrend 


结果 如 下 : 


Call: gim(formula = frequency ~ years, family = poisson(link = "identity"), 
data = StormDamageData, start = lIm(frequency ~ years, data = StormDamageData)$coefficients) 


coefficients: 
(Intercept) years 
-48. 69248 0.02594 
Degrees of Freedom: 105 Total (1.6. Null); 104 Residual 
Null Deviance: 143 
Residual Deviance: 105.1 AIC: 342 


HEENREIS Rena Ea. 


为 数 glm () 用 来 拟 合 广义 线性 模型 。frequency ~ years 定 义 公 式 ，data=stormDamage-Data 定 义 公式 的 数据 集 ， 函 数 
familyzpoisson (link= "log") 代表 泪 松 分 布 。 


使 用 以 下 命令 : 


> ExpTrend «- glm(frequency-years, data=StormDamageData, family = 
poisson (linkz"log")) 


输出 ExpTrend 的 内 容 : 


> ExpTrend 


结果 如 下 : 


Call: gim(formula = frequency ~ years, family = poisson(link = "Ίου, 
data = 5tormDamageData) 


coefficients: 
(Intercept) years 
-27. 66036 0.01446 
Degrees of Freedom: 105 Total (i.e. Null); 104 Residual 
Null Deviance: 143 
Residual Deviance: 104.7 AIC: 341.7 


绘制 1900 ~ 2005ΕΕΛΕΙΧΙΥΓΕΧΗΙΕΕ LO RUE, plot () 为 绘制 R 对 象 的 通用 函数 。years 代 表 绘 制 的 x 轴 ; frequency 代 表 绘 制 
的 y 轴 ; type= "h "代表 直 方 图 模式 ; ylim=c (0, 6) 设置 y 轴 的 限制 ， 下 限 为 0， 上 限 为 6: 


> plot (years, frequency, type-'h', ylim=c (0,6), main = "No. of Major 
Hurricanes Predicted for 2014", x1l1im-c(1900,2020)) 


结果 如 下 : 


预测 2014 年 的 主要 周 风 次 数 


1900 1920 1940 1960 1980 2000 2020 


年 份 





基于 指数 性 趋势 预测 2014 年 的 情况 。 冰 数 predict () 基于 线性 模型 对 象 预测 数值 。ExpTrend 代 表 从 Im 继承 的 类 的 对 象 。 
函数 newdata=data.frame (years=1890: 2030) 表示 查找 要 用 于 预测 的 变量 的 数据 框 : 


> cpredl <- predict(ExpTrend, newdata = data.frame(years-1890:2030), 
type="response") 


输出 cpred1 的 内 容 : 
> σρτεαῖ 


结果 如 下 : 


1 


. 7185495 0. 7290134 0. 


2 


3 


4 


5 


6 


7 


8 


9 


10 


11 


7396337 0.7504067 0.7613365 0.7724256 0. 78367602 0.7950907 0.8066714 0. 8184208 0.8303413 


12 13 14 15 16 17 18 19 20 21 22 
.8424355 0.8547058 0.8671549 0.8/97852 0.8925995 0.9056005 Ο. 9187908 0.9321733 0.9457507 0.9595258 0.9735015 
23 24 25 26 27 28 29 30 31 32 33 
- 9876809 1.0020667 1.0166621 1.0314701 1.0464937 1.0617362 1.0772007 1.0928905 1.1088087 1.1249588 1.1413442 
34 35 36 37 38 39 40 41 42 43 44 
-1579682 1.1/48343 1.1919461 1.2093072 1.2269211 1.2447915 1.2629223 1.2813171 1.2999798 1.3189144 1.3381248 
45 46 47 48 49 50 51 52 53 54 55 
1.3576149 1.3773890 1.3974511 1.4178053 1.4384561 1.4594076 1.4806643 1.5022306 1.5241110 1.5463101 1.5688326 
56 57 58 59 60 61 62 63 64 65 66 
1.5916830 1.6148664 1.6383874 1.6622509 1.6864621 1.7110259 1.7359475 1.7612320 1.7868849 1.8129114 1.8393170 
67 68 69 70 71 72 73 74 75 76 77 
1.8661071 1.8932875 1.9208638 1.9488417 1.9772272 2.0060260 2.0352444 0648883 2.0949640 2.1254777 1564359 
78 79 80 81 82 83 84 85 86 87 88 
.1878450 2.2197116 2.2520423 2.2848440 2.3181234 2.3518875 2.3861434 2.4208983 2.4561594 2.4919340 2.5282298 
89 90 91 92 93 94 95 96 97 98 99 
- 5650541 2.6024149 2. 6403198 2.6787768 2.7177940 2.7573794 2.7975414 2.8382884 2.8796289 2.9215715 2.9641250 
100 101 102 103 104 105 106 107 108 109 110 
.0072984 3.0511005 3.0955407 3.1406281 3.1863723 3.2327827 3.2798691 3.3276413 3.3761094 3.4252833 3.4751736 
111 112 113 114 115 116 117 118 119 120 121 
. 5257905 3.5771446 3.6292468 3.6821078 3.7357387 3.7901508 3.8453554 3.9013641 3.9581886 4.0158408 4.0743326 
122 123 124 125 126 127 128 129 130 131 132 
.1336765 4.1938846 4.2549698 4.3169446 4.3798221 4.4436155 4.5083380 4.5740033 4.6406249 4.7082170 4.7767935 

433 134 135 136 137 138 139 140 141 

. 8463688 4.9169576 4.9885745 5.0612345 5.1349528 5.2097449 5.2856263 5.3626129 5.4407209 


使 用 线段 连接 cpred1 的 点 。lines () E— FHERZA, Ἐ ΕΙ Εεργεα1ΗΗ/Β/ F7JySIBBSA^ ts, JPRPSINBS sa SEE 


XE, 1890: 2030 代 表 x 轴 : 
> lines (1890:2030, cpred1, col="blue") 
结果 如 下 : 
预测 2014 年 的 主要 飓风 次 数 


1 


1980 


o | 


1900 1920 1940 1960 


年 份 


2000 2020 


基于 线性 趋势 预测 2014 年 的 情况 。 函 数 predict () 基于 线性 模型 对 象 预测 数值 。LinearTrend 代 表 从 Im 继承 的 类 的 对 象 。 
函数 newdata=data.frame (years=1890: 2030) 表示 查找 要 用 于 预测 的 变量 的 数据 框 : 


> cpred0 <- predict (LinearTrend, newdata-data.frame(years-1890:2030), 
type="response") 


输出 cpred0 的 内 容 : 


> cpredO 
结果 如 下 : 
1 2 3 4 5 6 7 8 9 10 11 
0.3316616 0.3576003 0.3835390 0.4094777 0.4354164 0.4613551 0.4872938 0.5132325 0. 5391711 0.5651098 0. 5910485 
12 13 14 15 16 17 18 19 20 21 22 
0.6169872 0.6429259 0.6688646 0.6948033 0.7207420 0.7466807 0.7726194 0.7985581 0.8244968 0.8504355 0.8763742 
23 24 25 26 27 28 29 30 31 32 33 
0.9023129 0.9282516 0.9541903 0.9801290 1.0060677 1.0320064 1.0579451 1.0838838 1.1098225 1.1357612 1.1616999 
34 35 36 37 38 39 40 41 42 43 44 
1.1876386 1.2135773 1.2395160 1.2654547 1.2913934 1.3173321 1.3432708 1.3692095 1.3951482 1.4210869 1.4470256 
45 46 47 48 49 50 51 52 53 54 55 
1.4729643 1.4989030 1.5248417 1.5507804 1.5767191 1.6026578 1.6285965 1.6545352 1.6804739 1.7064126 1.7323513 
56 57 58 59 60 61 62 63 64 65 66 
1.7582900 1.7842287 1.8101673 1.8361060 1.8620447 1.8879834 1.9139221 1.9398608 1.9657995 1.9917382 2.0176769 
67 68 69 70 71 72 73 74 75 76 77 
2.0436156 2.0695543 2.0954930 2.1214317 2.1473704 2.1733091 2.1992478 2.2251865 2.2511252 2.2770639 2.3030026 
78 79 80 81 82 83 84 85 86 87 Bh 
2.3289413 2.3548800 2.3808187 2.4067574 2.4326961 2.4586348 2.4845735 2.5105122 2.5364509 2.5623896 2.5883283 
89 90 91 92 93 94 95 96 97 98 99 
2.6142670 2.6402057 2.6661444 2.6920831 2.7180218 2.7439605 2.7698992 2.7958379 2.8217766 2.8477153 2.8736540 
100 101 102 103 104 105 106 107 108 109 110 
2.8995927 2.9255314 2.9514701 2.9774088 3.0033475 3.0292862 3.0552249 3.0811636 3.1071022 3.1330409 3.1589796 
111 112 113 114 115 116 117 118 119 120 121 
3.1849183 3.2108570 3.2367957 3.2627344 3.2886731 3.3146118 3.3405505 3.3664892 3.3924279 3.4183666 3.4443053 
122 123 124 125 126 127 128 129 130 131 132 
3.4702440 3.4961827 3.5221214 3.5480601 3.5739988 3.5999375 3.6258762 3.6518149 3.6777536 3.7036923 3.7296310 
133 134 135 136 137 138 139 140 141 
3.7555697 3.7815084 3.8074471 3.8333858 3.8593245 3.8852632 3.9112019 3.9371406 3.9630793 
使 用 线段 连接 cpred0 的 点 。lines () 是 一 个 通用 函数 ， 它 将 数据 框 cpred0 的 值 作为 y 轴 的 坐标 ， 并 将 对 应 的 点 与 线段 相 


连 。1890: 2030 代 表 x 轴 : 


> lines(1890:2030, cpred0, col="red")) 


结果 如 下 : 


h=mean (StormDamageData$frequency) 是 水 平 线 的 y 轴 值 : 
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绘制 均值 。 函 数 abline () 使 用 StormDamageData$frequency 的 值 为 1.95283 的 均值 绘制 直线 。 


2020 


> abline(h = mean(StormDamageData$frequency), col-z"black") 


结果 如 下 : 


预测 2014 年 的 主要 飓风 次 数 
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结合 StormDamageData$frequency 的 均值 、cpred0 和 cpred1 的 数据 框 : 


> predictions «- cbind(constant = mean(StormDamageData$frequency), 
linear - cpred0[126], exponential-cpred1[126]) 


输出 predictions 的 内 容 : 
> predictions 


结果 如 下 : 


constant linear exponential 
126 1.95283 3.573999 4. 379822 


在 图 表 中 绘制 2014 年 预测 的 点 : 


> points(rep((1890:2030)[126],3), predictions, 
colzc("black","red","blue"), pch=19) 


结果 如 下 : 
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值得 注意 的 是 ， 通 过 改变 预测 覃 型， 保费 会 及 生变 化 。 采 用 平凡 预测 ， (主要 ) WRDXULTATSRUZZR, BARKAN, 
(主要 ) ΜΕΙΧΙΖΘ ΓΔΑ. 


第 6 步 : 计算 再 保险 合同 的 纯 溢 价 


现在 我 们 找到 一 个 合适 的 模型 ， 在 可 扣除 和 有 限 的 保险 荡 围 内 来 计算 再 保险 条 约 的 保费 。 使 用 如 下 的 Hil| 的 尾部 指数 模拟 器 
估计 尾 部 指数 。 函 数 hill () 用 于 估计 长 尾数 据 base$Normalized.PL05 的 尾部 指数 : 


> hill(base$Normalized.PL05) 


结果 如 下 : 


P fF 


1656110 7686-09 4026109 3026109 1606109 1056109 613e+08 3586-08 2456108 1526108 1056108 531e407 268e407 571e«06 


15 


alpha (CI, p 20.95) 
1.0 


0.5 





15 21 27 33 39 45 51 5/7 63 69 75 81 87 93 99 105 112 119 126 133 140 147 154 161 168 1/5 182 189 196 203 


保单 统计 值 


上 面 的 图 表 显 示 主 要 艰 风 的 损失 为 长 尾数 气 。 


设置 Pareto 模 型 的 阀 值 为 5 人 亿 以 上 : 


> threshold «- .5 


使 用 以 下 命令 返回 一 个 类 的 对 象 gpd， 表 示 广 义 Pareto 模 型 的 拟 合 来 超过 靖 值 (0.5) 。base$Normalized.PLO5/1e9/20 代 
表 数 据 集 : 


> gpd.PL <- gpd(base$Normalized.PL05/1e9/20, threshold) $par.ests 
结果 如 下 : 


x1 beta 
0.4424669 0.6705315 


计算 数据 框 base$Normalized.CL05/1e9/20 中 大 于 阅 值 0.5 的 均值 : 


> mean(base$Normalized.CL05/1e9/20» .5) 


结果 如 下 : 


[1] 0.1256039 


给 定 超过 5 亿 的 损失 ， 计 算 再 保险 合同 的 预期 价值 


d+c 
| (x—d)dF_ (x) 


> ExpectedValue <- function(yinf,ysup,xi,beta)( 
+ as.numeric(integrate(function(x) (x-yinf) * 
dgpd (x, xi, mu=threshold, beta), 
+ lower-yinf,upper-ysup)$value + 
+ (l-pgpd(ysup,xi,mu-threshold,beta))*(ysup-yinf)) 
+ 


找 出 数据 框 predictions 的 均值 : 


> predictions[1] 
结果 如 下 : 
[1] 1.95283 
计算 数据 框 base$Normalized.PLO5/1e9/20 中 大 于 阅 值 0.5 的 均值 : 


> mean (base$Normalized.PL05/1e9/20>.5) 


结果 如 下 : 


[1] 0.1256039 
&EXWNBIXUA AGES SALETTA IE 73 12.596, 


结果 显示 ， 对 于 保险 公司 而 言 ， 


计算 再 保险 合同 的 预期 价值 : 


> ExpectedValue (2,6,gpd.PL[1],gpd.PL[2])*1e3 


结果 如 下 : 
[1] 330.9865 


结果 显示 ， 再 保险 公司 的 预期 偿还 额 约 为 3.309865 亿 元 。 


计算 再 保险 合同 溢价 
> predictions[1] * mean(base$Normalized.PL05/1e9/20» .5) * 
6, gpd.PL[1], gpd.PL[2]) * 1e3 


ExpectedValue (2, 
结果 如 下 : 


[1] 81.18538 


第 14 章 ”案例 研究 : 用 电量 预测 


14.1 引言 
电力 是 唯一 一 种 边 生 产 边 消费 的 商品 。 因 此 ， 必 须 始 终 保 持 电 力 市 场 供 需 平衡 。 任 何 国家 的 电力 消耗 预测 都 是 国家 利益 的 天 
键 ， 因 为 电力 是 能 源 的 重要 来 源 。 可 靠 预测 能 源 消 费 、 生 产 和 输送 符合 稳定 长 远 的 政策 。 经 济 规模 的 仓 人 在 ， 包 括 环境 关注、 监管 
要 求 和 民 好 的 公众 形象 ， 加 上 通货 膨胀 、 能 源 价 格 快速 上 涨 、 蔡 代 燃 料 和 技术 的 出 现 、 生 活 方式 的 变化 等 ， 已 经 形成 了 需要 使 用 
建 模 技 术 来 捕捉 一 些 参 数 ， 诸 如 价格 、 收 和 入、 人口、 技术 、 其 他 经 济 、 人 口 统 计 学 、 政 策 和 技术 变量 等 因素 的 影响 。 
产能 不 足 ， 进 而 导致 服务 质量 差 ， 包 括 局 部 断 电 ， 甚 至 停电 。 而 另 一 方面 ， 过 高 估计 可 能 授权 一 个 未 
够 确保 最 优 的 投资 阶段 、 长 期 考虑 、 合 理化 定价 结构 和 设计 需求 侧 管 理 计 
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一 万 面 ， 低 佑 可 能 导致 
来 几 年 并 不 需要 的 友 电 三 的 建设 。 正 确 预测 用 电 
划 ， 以 满足 短期 和 中 期 需求 的 性 质 。 预 测 进 一 步 推动 投资 、 建 
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电力 是 唯一 一 种 边 生 产 边 消 费 的 商品 。 因 此 ， 必 须 始终 保持 电力 市 场 供需 平衡 。 任 何 国家 的 电力 消耗 预测 都 是 国家 利益 的 关 
键 ， 因 为 电力 是 能 源 的 重要 来 源 。 可 靠 预测 能 源 消费 、 生 产 和 和 输送 符合 稳定 长 远 的 政策 。 经 济 规模 的 仓 人 在， 包括 环境 关注 、 监 管 
要 求 和 民 好 的 公众 形象 ， 加 上 通货 膨胀 、 能 源 价格 快速 上 涨 、 蔡 代 黎 料 和 反 术 的 出 现 、 生 活 方式 的 变化 等 ， 已 经 形成 了 需要 使 用 
建 模 技术 来 捕捉 一 些 参数 ， 诸 如 价格 、 收 入 、 人 口 、 技 术 、 其 他 经 济 、 人 口 统计 学 、 政 策 和 技术 变量 等 因素 的 影响 。 


一 方面 ， 低 估 可 能 导致 产能 不 足 ， 进 而 导致 服务 质量 差 ， 包 括 局 部 断 电 ， 甚 全 停电 。 而 另 一 方面 ， 过 高 估计 可 能 授权 一 个 未 
来 几 年 并 不 需要 的 友 电 三 的 建设 。 正 确 预 测 用 电量 能 够 确保 最 优 的 投资 阶段 、 长 期 考虑、 合理 化 定价 结构 和 设计 需求 侧 管理 计 
划 ， 以 满足 短期 和 中 期 需求 的 性 质 。 预 测 进一步 推动 投资 、 建 设 、 书 约 的 各 项 计划 和 决策 。 





14.2 用 电量 测量 


准备 工作 
我 们 使 用 收集 的 4 个 地 区 行业 汇 忌 的 智能 电表 数据 集 来 预测 电力 消费 。 
第 1 步 : 收集 和 摘 述 数据 
使 用 的 数据 集 命名 为 DT_ 4 ind， 数 值 型 变量 如 下 : 
- value 
JFB EAN ΤΡ: 
- date. time 
- week 


: date 
j type 
具体 实施 步骤 
以 下 为 实现 细节 。 
第 2 步 : 探索 数据 


首先 加 载 以 下 程序 包 : 


install.packages("feather") 
install.packages("data.table") 
install.packages("ggplot2") 
install.packages("plotly") 
install.packages("animation") 
library(feather) 

library (data.table) 

library (ggplot2) 

library (plotly) 

library (animation) 


V V V V V V V V V V 


版 本 信息 : 代码 测试 的 R 语 言 版 本 为 3.3.2。 
现在 开始 探索 数据 并 理解 参数 之 间 的 关系 。 


使 用 as.data.table () 检测 对 象 。 使 用 feather 进 行 数 据 框 的 二 元 柱状 序列 化 。 使 用 feather 使 得 数据 分 析 语 言 乙 间 共 享 、 
取 和 写 入 数据 更 简单 。 函 数 read feather () 用 于 读 取 feather 文 件 。 


我 们 导入 数据 集 DT_4_ind 并 保存 在 数据 框 AppData 中 : 


> AggData «- as.data.table(read feather("d:/DT 4 ind")) 


探索 AppData 数 据 框 的 内 部 结构 。 使 用 水 数 str () 探索 作为 R 对 象 的 AppData 数 据 框 的 内 部 结构 : 


> str (AggData) 


结果 如 下 : 


Classes 'data.table' and 'data.frame': 70080 obs. of 5 variables: 
$ date time: POSIXCt, format: "2012-01-02 00:00:00" "2012-01-02 00:30:00" "2012-01-02 01:00:00" "2012-01-02 01:30:00" 


$ value : num 1590 1564 1560 1585 1604 ... 

$ week : chr "Monday" "Monday" "Monday" "Monday" να 

$ date : Date, format: "2012-01-02" "2012-01-02" "2012- 01- 02" "2012-01-02" ... 

$ type : chr "commercial Property" "commercial Property" "Commercial Property" "Commercial Property" ... 
- attr(*, ".internal.selfref")-«externalptr- 


输出 AggData 数 据 框 。 使 用 函数 head () xx[BlAggDataZWTsTERJSL ED, EuroUSD(EZSPRZXES 8 A ZA : 


> head(AggData) 


结果 如 下 : 


date time value week date type 
: 2012-01-02 00:00:00 1590.210 Monday 2012-01-02 Commercial Property 
: 2012-01-02 00:30:00 1563.772 Monday 2012-01-02 Commercial Property 
: 2012-01-02 01:00:00 1559.914 Monday 2012-01-02 commercial Property 
: 2012-01-02 01:30:00 1584.671 Monday 2012-01-02 Commercial Property 
: 2012-01-02 02:00:00 1604.281 Monday 2012-01-02 Commercial Property 
: 2012-01-02 02:30:00 1566.582 Monday 2012-01-02 Commercial Property 


σι un & w N F: 


绘制 汇总 的 行业 电力 消费 的 时 间 序 列 数据 。 


负数 ggplot () 声明 一 个 图 形 的 输入 数据 框 ， 并 指定 了 一 组 在 整个 图 形 中 共同 使 用 的 图 形 样式 。data=AggData 代 表 用 于 
绘制 的 数据 集 ，aes () 摘 述 数据 中 的 变量 如 何 映射 到 可 视 化 属性 。geom_line () 产生 试图 连接 所 有 观察 的 简单 线 : 


> ggplot (data = AggData, aes(x = date, y = value)) + 
+ geom line() + 
+ facet grid(type  ., scales = "free y") + 
+ theme(panel.border = element blank(), 
+ panel.background = element blank(), 
+ panel.grid.minor = element line(colour = "grey90"), 
+ panel.grid.major = element line(colour = "green"), 
+ panel.grid.major.x = element line(colour = "red"), 
+ axis.text = element text (size = 10), 
+ axis.title = element text(size = 12, face = "bold"), 
+ strip.text = element text(size = 9, face = "bold")) + 
+ labs(title = "Electricity Consumption - Industry", x = "Date", y = 
"Load (kW) ") 
结果 如 下 : 


b: 


电力 消耗 : 工业 
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日 期 
值得 注意 的 是 ， 相 比 于 其 他 行业 ， 行 业 Food Sales%storage 的 消费 在 假期 没有 太 大 的 变化 。 
第 3 步 : 时 间 序 列 : 回归 分 析 


回归 模型 方程 如 下 : 


γιπριάῃ ^ad; + +++ +pasdiag +Ba9Wi + *** 十 O54Wi6 十 5i 


参数 (输入 ) 为 两 种 类 型 的 周期 性 虚拟 变量 : 每 日 (d1，…，d48) 和 每 周 (w4, ..., weg) 。yi 为 在 时 间 i 的 电力 消 
，i=1，...，N。B1，.….，Bs54 为 要 估计 的 回归 系数 。 


输出 数据 框 AppData 的 内 容 : 


> AggData 


Λμούοιαά IBloJouwuuoD 


ΗΟΠΕΟΠΡ34 


οὔειο]ς * 59|85 poo4 


IeIQsnpul 467 


结果 如 下 : 


date time value week date type 
: 2012-01-02 00:00:00 1590. 210 Monday 2012-01-02 commercial Property 
: 2012-01-02 00:30:00 1563.772 Monday 2012-01-02 commercial Property 
: 2012-01-02 01:00:00 1559.914 Monday 2012-01-02 commercial Property 
: 2012-01-02 01:30:00 1584.671 Monday 2012-01-02 commercial Property 
2012-01-02 02:00:00 1604.281 Monday 2012-01-02 commercial Property 


70076: 2012-12-31 21:30: 
70077: 2012-12-31 22:00: 
70078: 2012-12-31 22:30: 
70079: 2012-12-31 23:00: 
70080: 2012-12-31 23:30: 


3548.279 Monday 2012-12-31 Light Industrial 
3488.161 Monday 2012-12-31 Light Industrial 
3510.200 Monday 2012-12-31 Light Industrial 
3533.678 Monday 2012-12-31 Light Industrial 
3414.966 Monday 2012-12-31 Light Industrial 


99922 9825282 


将 星期 变量 转换 为 整数 : fBRgEEÉXas.factor () 将 向 量 编码 为 参数 。 国 数 as.factor () 创建 整数 类 型 的 对 象 
AggData[, week]: 


> AggData[, week num := as.integer(as.factor(AggData[, week]))] 


输出 数据 框 AppData 变 化 后 的 内 容 : 


> AggData 
结果 如 下 : 
date time value week date type week num 
1: 2012-01-02 00:00:00 1590.210 Monday 2012-01-02 commercial Property 2 
2: 2012-01-02 00:30:00 1563.772 Monday 2012-01-02 commercial Property 2 
3: 2012-01-02 01:00:00 1559.914 Monday 2012-01-02 Commercial Property 2 
4: 2012-01-02 01:30:00 1584.671 Monday 2012-01-02 commercial Property 2 
5: 2012-01-02 02:00:00 1604.281 Monday 2012-01-02 commercial Property 2 
70076: 2012-12-31 21:30:00 3548.279 Monday 2012-12-31 Light Industrial 2 
70077: 2012-12-31 22:00:00 3488.161 Monday 2012-12-31 Light industrial 2 
70078: 2012-12-31 22:30:00 3510.200 Monday 2012-12-31 Light Industrial 2 
70079: 2012-12-31 23:00:00 3533.678 Monday 2012-12-31 Light industrial 2 
70080: 2012-12-31 23:30:00 3414.966 Monday 2012-12-31 Light industrial 2 
从 数据 框 AppData 中 提取 唯一 行业 类 型 : 
> n type «- unique(AggData[, typel) 
输出 数据 框 n_type 改 变 后 的 内 容 : 
> n type 
结果 如 下 : 
[1] "commercial Property" "Education" "Food Sales & Storage" "Light Industrial" 


从 数据 框 AppData 中 提取 唯一 的 日 期 : 


> n date «- unique(AggData[, date]) 


从 数据 框 AppData 中 提取 唯一 的 星期 |: 


> n weekdays «- unique(AggData[, week]) 


如 下 设置 period 的 值 : 


> period «- 48 


在 简单 数据 集 上 执行 回归 分 析 。 


我 们 提取 教育 (学 校 建筑 ) 两 星期 的 值 ， 结 果 保 存在 数据 框 data_reg 中 。n_type[2] 代 表 教 育 建筑 ，n_type[57: 70] 代 表 一 
个 两 星期 的 时 间 段 : 


> data reg «- AggData[(type -- n type[2] & date $in$ n date[57:70])] 


输出 数据 框 data_reg 改 变 后 的 内 容 : 


> data reg 


结果 如 下 : 
date_time value week date type week_num 
1: 2012-02-27 00:00:00 652.0693 Monday 2012-02-27 Education 2 
2: 2012-02-27 00:30:00 646.6226 Monday 2012-02-27 Education 2 
3: 2012-02-27 01:00:00 658.3790 Monday 2012-02-27 Education 2 
4: 2012-02-27 01:30:00 669.0898 Monday 2012-02-27 Education 2 
5: 2012-02-27 02:00:00 675.9707 Monday 2012-02-27 Education 2 
668: 2012-03-11 21:30:00 514.5865 sunday 2012-03-11 Education 4 
669: 2012-03-11 22:00:00 505.0426 Sunday 2012-03-11 Education 4 
670: 2012-03-11 22:30:00 508.6684 sunday 2012-03-11 Education 4 
671: 2012-03-11 23:00:00 511.6602? sunday 2012-03-11 Education 4 
672: 2012-03-11 23:30:00 522.0277 Sunday 2012-03-11 Education 4 


绘制 教育 (学校 建筑 ) 两 星期 (2 月 27 日 ~ 3 月 12 日 ) 的 简单 数据 集 。 


负数 ggplot () 声明 一 个 图 形 的 输入 数据 框 ， 并 指定 了 一 组 在 整个 图 形 中 共同 使 用 的 图 形 样式 。data_reg 代 表 用 于 绘制 的 
数据 集 ，aes () 搞 述 数据 中 的 变量 如 何 映射 到 可 视 化 属性 。geom_line () 产生 试图 连接 所 有 观察 的 简单 线 : 


> ggplot(data reg, aes(date time, value)) + 

+ geom line() + 

+ theme(panel.border = element blank(), 

+ panel.background = element blank(), 

+ panel.grid.minor = element line(colour = "grey90"), 
+ panel.grid.major = element line(colour = "green"), 
+ panel.grid.major.x = element line(colour = "red"), 
十 


axis.text = element 七 ext (size = 10), 


+ axis.title = element text(size = 12, face = "bold")) 
+ labs (title = "Regression Analysis - Education Buildings", x = "Date", 
y = "Load (kW)") 


结果 如 下 : 
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从 数据 框 data_reg 中 提取 行 数 : 
> N «- nrow(data reg) 
计算 训练 数据 集中 日 期 数 : 


> trainset window «- Ν / period 


创建 独立 的 周期 性 虚拟 变量 : 每 日 (di, .., dag) 和 每 周 (w4, .., wg) 。 每 日 的 周期 性 变量 从 1，.…，period，1， 


…，Period 的 48 个 变量 中 提取 ， 每 星期 变量 从 week_num 中 提取 ， 结 果 保 存在 向 量 matrix_train 中 : 


> matrix train «- data.table(Load = data reg[, value], Daily = 
as.factor(rep(1:period, trainset window)), Weekly = as.factor (data reg[, 
week num])) 


输出 数据 框 matrix train 改 变 后 的 内 容 : 


> matrix train 


结果 如 下 : 


1: 652.0693 1 2 

2: 646.6226 2 2 

3: 658.3790 3 2 

4: 669.0898 4 2 

5: 675.9707 5 2 
668: 514.5865 44 4 
669: 505.0426 45 = 
670: 508. 6684 46 4 
6/1: 511.6602 47 4 
672: 522.0277 48 - 


Load Daily weekly 


PERHERE., Alm () 拟 合 线性 模型 : Load ~ 0+ .为 拟 合 公式 。 由 于 函数 Im () 自动 为 线性 模型 添加 截 距 项 ， 我 们 定 
义 其 为 0。data=matrix train 代表 包 合 数 据 的 数据 框 : 


生成 模型 inear model 1 的 概要 结果 : 


> summary 1 «- summary(linear model 1) 


输出 数据 框 summary 1 改变 后 的 内 容 : 


> summary 1 


结果 如 下 : 


> linear model 1 «- lm(Load ~ 0 + ., data = matrix train) 
输出 数据 框 linear model 1 改变 后 的 内 容 : 
> linear model 1 
结果 如 下 : 
call: 
Im(formula = Load ~ O + ., data = matrix train) 
coefficients: 
Dailyl Daily? Daily3 Daily4 Daily5  Daily6  Daily7  Daily8  Daily9 DailylO Dailyll1 Daily12 
964.406 925. 54 8/4.87 842.27 821.33 799. 04 767.56 737.28 722.42 715.04 708.85 709. 57 
Dailyl3 Dailyl4 Daily15 Dailyl6 Dailyl7 Dailyl8 Daily19 Daily20 Daily21 Daily22 Daily23 Daily24 
712.85 712. 02 724.55 729.16 729.94 732.19 750. 64 700.74 798.12 839.97 1006.45 1171.81 
Daily25 Daily26 Daily27 Daily28 Daily29 Daily30 Daily31 Daily32 Daily33 Daily34 Daily35 Daily36 
1319.01 1458.93 1555.40 1603.95 1623.88 1628.66 1637.48 1658.36 1657.23 1653.48 1654.59 1623.13 
Daily37 Daily38 Daily39 Daily40 Daily41 Daily42 Daily43 Daily44 Daily45 Daily46 Daily47 Daily48 
1573.42 1540.26 1514.78 1487.84 1427.99 1334.33 1239.45 1172.6? 1108.44 1073.54 1013.76 973.76 
weekly2 weekly3 weekly4 weekly5 Wweekly6 weekly? 
100.99 -516.80 -539.96 54.58 86.11 61.52 


Call: 


lm(formula = Load ~ O + ., data = matrix train) 
Residuals: 

Min 1Q Median 3Q Max 
-561.87 -149.34 -15.13 181.13 477.75 
coefficients: 

Estimate Std. Error t value Pr(»|t|) 

Dai ly1 064.46 71.40 13.508 < 2e-16 *** 
Dai ly2 925. 54 71.40 12.963 < 2e-16 *** 
Dai ly3 874.87 71.40 12.253 < 2e-16 *** 
Daily4 842.27 71.40 11.797 < 2e-16 *** 
Daily5 821.33 71.40 11.503 < 2e-16 *** 
Daily6 799.04 71.40 11.191 < 2e-16 *** 
Daily7 767.56 71.40 10.750 < 2e-16 *** 
Dai 1γ8 737.28 71.40 10.326 < 2e-16 *** 
Dai ly9 722.42 71.40 10.118 < 2e-16 *** 
Dai ly10 715.04 71.40 10.015 < 286-16 *** 
Dailyll 708.85 71.40 9.928 < 28-16 *** 
Dai ly12 709. 57 71.40 9.938 < 2e-16 *** 
Daily13 712.85 71.40 9.984 < 26-16 www 
Dai ly14 712.02 71.40 9.972 < 2e-16 *** 
Daily15 724.55 71.40 10.148 < 2e-16 *** 
Daily16 729.16 71.40 10.21? < 286-16 *** 
Daily17 729. 94 71.40 10.223 < 2e-16 *** 
Daily18 732.19 71.40 10.255 «26-16 *** 
Daily19 750.064 71.40 10.513 < 2e-16 *** 
Daily20 760. 74 71.40 10.655 «26-16 *** 
Dai ly21 /98.12 71.40 11.178 < 2e-16 *** 
Dai ly22 839.97 71.40 11.764 < 2e-16 *** 
Daily23 1006.45 71.40 314.096 < 2e-16 *** 
Daily24 1171.81 71.40 16.412 < 2e-16 *** 
signif. codes: ο '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1" ' 1 


Residual standard error: 251.9 on 618 degrees of freedom 
Multiple R-squared: 0.9547, Adjusted R-squared: 0.9508 
F-statistic: 241.3 on 54 and 618 DF, p-value: < 2.2e-16 


从 数据 框 summary_ 1 中 使 用 rsquared 属 性 提取 可 决 系数 : 


> paste("R-squared: ", round(summary 1$r.squared, 3), ", p-value of F 
test: ", 1-pf(summary 1$fstatistic[1], summary 1$fstatistic[2], 
summary 1$fstatistic[3])) 
[1] "R-squared: 0.955 , p-value of F test: 0” 
从 列表 data reg 和 linear model 1 中 创建 data.table: 
> datas «- rbindlist(list(data reg[, .(value, date time)], 


data.table(value - 
date time]))) 


linear model 1$fitted.values, data time = data reg[, 


输出 数据 框 datas 改 变 后 的 内 容 : 


> datas 


结果 如 下 : 


Value date time 
: 652.0693 2012-02-27 00:00: 
: 646.6226 2012-02-27 00:30: 
: 658. 3790 2012-02-27 01:00: 
: 669.0898 2012-02-27 01:30: 
: 675.9707 2012-02-27 02:00: 


un d» UN IF 


1340: 632.6548 2012-03-11 21:30: 
1341: 568.4755 2012-03-11 22:00: 
1342: 533.581/ 2012-03-11 22:30: 
1343: 473.8017 2012-03-11 23:00: 
1344: 433.7951 2012-03-11 23:30: 


s8883 SSS888 


绘制 linear model 1 的 拟 合 值 。 


data=datas 代 表 用 于 绘制 的 数据 集 ，aes () 摘 述 数据 中 的 变量 如 何 映射 到 可 视 化 属性 。geom_line () 产生 试图 连接 所 有 
观察 的 简单 线 : 
> ggplot(data = datas, aes(date time, value, group = type, colour = 
type)) + geom line(size = 0.8) + theme bw() + 


+ labs(x = "Time", y = "Load (kW)", title = "Fit from Multiple Linear 
Regression") 


结果 如 下 : 


拟 合 多 重 线性 回归 
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绘制 拟 合 值 与 残 差 值 。 


data 代 表 用 于 绘制 的 数据 集 ，aes () 描述 数据 中 的 变量 如 何 映射 到 可 视 化 属性 。geom line () 产生 试图 连接 所 有 观察 的 
简单 线 : 


> ggplot(data = data.table(Fitted values = 

linear model 1$fitted.values,Residuals = 

linear model 1$residuals),aes(Fitted values, Residuals)) 
+ geom point(size = 1.7) + 


+ geom smooth() + 
+ geom hline(yintercept = 0, color = "red", size = 1) + 
+ labs (title = "Fitted values vs Residuals") 
结果 如 下 : 
拟 合 值 与 残 差 
. 9 M 9 
τα : t > E 
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ggOO <- function (lm) { 

extracting residuals from the fit 

d <- data.frame(std.resid = rstandard(1m)) 

calculate 1Ο, 40 line 

y <- quantile (d$std.resid[!is.na(d$std.resid)], c(0.25, 0.75)) 
calculate 1Ο, 40 line 

x «- qnorm(c(0.25, 0.75)) 

slope <- diff(y)/diff (x) 

int <- y[1L] - slope * x[1L] 


p <- ggplot (data = d, aes (sample = std.resid)) + 

stat qq(shape = 1, size = 3) + 

labs (title = "Normal Q-Q", 

x = "Theoretical Quantiles", 

y = "Standardized Residuals") + 

geom_abline (slope = slope, intercept = int, linetype = "dashed", 
size = 1, col = "firebrick1") 

return (p) 


} 


+ + + + + + + + + + + + + # + #* + + V 


使 用 以 下 命令 绘制 正 态 Q-Q: 


> ggOQO(linear model 1) 


结果 如 下 : 


正 态 Q-Q 图 


e 
1 


归 一 化 残 差 


=b 
1 
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统计 分 位 所 


清楚 可 见 ， 这 些 点 不 正常 ， 因 为 它们 远离 红线 。 日 期 的 测量 值 不 断 地 以 星期 变量 的 估计 系数 移动 ， 但 日 期 的 行为 未 被 捕获 。 
我 们 需要 捕捉 这 种 行为 ， 因 为 (特别 是 周末 ) 行为 绝对 不 同 。 


第 4 步 : 时 间 序 列 : 提高 回归 分 析 


创建 线性 模型 。 函 数 Im () 拟 合 线性 模型 : Load ~ 0+Daily+Weekly+Daily: Weekly 为 新 的 拟 合 公式 。 由 于 函数 Im () ΕΒ 
动 为 线性 模型 添加 截 距 项 ， 我 们 定义 其 为 0。data=matrix_train 代 表 包 含 数据 的 数据 框 : 


> linear model 2 <- lm(Load ~ 0 + Daily + Weekly + Daily:Weekly, data = 
matrix train) 


输出 数据 框 linear model 2 改变 后 的 内 容 : 


> linear model 2 


结果 如 下 : 


Call: 


1m(formula = Load ~ O + Daily + weekly + Daily:weekly, data = matrix train) 


Coefficients: 
Dailyl Daily2 Daily3 Daily4 
963. 6868 910.1281 832.4827 767. 9888 
Daily8 Dai ly9 Dai ly10 Dai ly11 
607 . 0952 593.1229 579. 3818 571.4749 
Daily15 Daily16 Daily17 Daily18 
590. 8817 596. 6877 599.9783 596.8332 
Daily22 Daily23 Daily24 Daily25 
742.3322 951.7756 1158.7365 1339.7397 
Daily29 Daily30 Daily31 Daily32 
1812. 0905 1827.8779 1834.1506 1869. 0104 
Dai 1y36 Dai 1y37 Daily38 Daily39 
1789.6251 1731. 6673 1082. 2293 1586.0122 
Daily43 Daily44 Daily45 Daily46 
1245.7848 1166.1215 1091.9825 1066.7010 
week1y3 weekly4 weekly5 weekly6 
-42.9479 -383.8207 -47.4477 43.1739 
Daily4:weekly2 . Daily5:weekly2 . Daily6:weekly2 . Daily7:weekly2 
211.0272 238.7233 273.2973 342. 3193 
Dailyll:weekly2  Dailyl2:weekly2 JDailyl13:weekly2  Daily14:weekly2 
433.0777 432.5059 439.6293 428.7760 
Dailyl8:weekly2  Daily19:weekly2  Daily20:weekly2  Daily21:weekly2 
441.2555 483. 8489 489.4588 450. 5552 
Daily25:weekly2  Daily26:weekly2  Daily27:weekly2  Daily28:weekly2 
635.9273 645. 8638 629.4519 538.6554 
Daily32:weekly2  Daily33:weekly2 JDaily3A:weekly2  Daily35:weekly2 
516.8237 507.8630 524.8920 514.2205 
Daily39:weekly2  Daily40:weekly2 Daily41:weekly2  Daily42:weekly2 
603.7991 572.5889 557.3761 561.1792 
Daily46:weekly2  Daily47:weekly2 Daily48:weekly2 . Daily2:weekly3 
491.0887 477.7638 443.8735 5.5692 


比较 linear model 1 和 linear model 2 模型 的 摘要 中 的 R 平 方 值 : 


> c(Previous = 


summary (linear model 2)$r.squared) 


结果 如 下 : 


Previous New 
0.9547247 0.9989725 


第 二 个 模型 的 R 平 方 值 有 显著 的 改善 。 
以 图 像 方式 比较 linear model 1 和 linear model 2 模型 的 残 差 : 


> ggplot (data.table (Residuals = 
linear model 2$residuals), Type = 
nrow(data reg)), 


nrow (data reg)))), Residuals, 


> ggplotly() 


aes (Type, 


结果 如 下 : 


fill = 


Daily5 

746. 0964 

Dai ly12 
577.7818 
Daily19 

605. 5058 
Daily26 
1530.8187 

Dai 1y33 
1875.9046 
Daily40 
1571.6402 
Daily47 
997.4765 
week1ly7 
38.2679 
Daily8:weekly2 
382.9568 
Daily15:weekly?2 
429.8100 
Daily22:weekly?2 
461.8552 
Daily29:weekly?2 
531.7929 
Daily36:weekly?2 
531.7239 
Daily43:weekly2 
551. 5947 
Daily3:weekly3 
10.2973 


Daily6 

709.4052 

Dai 1y13 
5/5.1910 
Daily20 
617.2628 
Daily27 
1680.5525 

Dai 1y34 
1860.0126 
Daily41 
1496.8899 
Daily48 

955. 2032 
Daily2:weekly2 
46.9318 

Dai ly9:weekly?2 
393.0218 

Dai ly16:weekly?2 
424.0835 
Daily23:weekly2 
547.1952 

Dai ly30:weekly2 
506. 9881 

Dai 1y37 :weekly?2 
513.5249 
Daily44:Wweekly2 
539.1175 

Dai ly4:weekly3 
32.1318 


summary(linear model 1)$r.squared, New = 


Cc(linear model 1$residuals, 
c(rep("Multiple Linear Reg - simple", 
rep("Multiple Linear Reg with interactions", 


Dai ly7 

646.7310 

Dai ly14 
576.0727 
Daily21 
685.2319 
Daily28 
1772.6732 
Daily35 

1846. 6024 

Dai ly42 
1358.2929 
week1y2 

-355. 3522 

Dai ly3:weekly2 
138.6611 
Daily10:weekly2 
420. 0024 

Dai 1y17 :weekly2 
429. 2114 
Daily24:weekly2 
614. 2202 

Dai ly31:Wweekly2 
510. 5959 

Dai 1y38:weekly2 
515. 8282 
Daily45:weekly2 
529. 6320 

Dai ly5:weekly3 
32.9816 


Type)) * geom boxplot () 


-300 - 


多 重 线性 回归 : 简单 


显示 linear model 1 残 差 的 细节 。 


结果 如 下 : 


显示 linear model 2 残 差 的 细节 。 


结果 如 下 : 
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多 重 线性 回归 : 交互 
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多 重 线性 回归 : 交互 


类 型 
EZEREN: 简单 
um BAR: 交互 


ο «d. Πα να m= h 


目 多 重 线性 回归 : 人 简单 
EZERRE: 交互 





目 多 重 线性 回归 : 简单 
mur: 交互 


300- 





-300- 


多 重 线性 回归 ， 简单 多 重 线性 回归 ;交互 
类 型 


从 列表 data_ reg 和 和 linear model 2 创建 data.table: 


> datas «- rbindlist(list(data reg[, .(value, date time)], 
data.table(value - linear model 2$fitted.values, data time - data reg[, 
date time]))) 


输出 数据 框 datas 改 变 后 的 内 容 : 


> datas 


结果 如 下 : 


Value date ti 

1: 652.0693 2012-02-27 00:00: 

2: 646.6226 2012-02-27 00:30: 

3: 658.3790 2012-02-27 01:00: 

4: 669.0898 2012-02-27 01:30: 

5: 675.9707 2012-02-27 02:00: 
1340: 517.3413 2012-03-11 21:30: 
1341: 512.7296 2012-03-11 22:00: 
1342: 513.3986 2012-03-11 22:30: 
1343: 517.8433 2012-03-11 23:00: 
1344: 527.1080 2012-03-11 23:30: 


58838 3833833 


为 datas 添 加 列 Real 和 Fitted : 


> datas[, type := rep(c("Real", "Fitted"), each = nrow(data reg))] 


输出 数据 框 datas 改 变 后 的 内 容 : 


> datas 


结果 如 下 : 


Value date time type 

1: 652.0693 2012-02-27 00:00:00 Real 

2: 646.6226 2012-02-27 00:30:00 Real 

3: 658.3790 2012-02-27 01:00:00 Real 

4: 669.0898 2012-02-27 01:30:00 Real 

5: 675.9707 2012-02-27 02:00:00 Real 
1340: 517.3413 2012-03-11 21:30:00 Fitted 
1341: 512.7296 2012-03-11 22:00:00 Fitted 
1342: 513.3986 2012-03-11 22:30:00 Fitted 
1343: 517.8433 2012-03-11 23:00:00 Fitted 
1344: 527.1080 2012-03-11 23:30:00 Fitted 


绘制 linear model 2 的 拟 合 值 。 


data=datas 代 表 用 于 绘制 的 数据 集 ，aes () 描述 数据 中 的 变量 如 何 映 射 到 可 视 化 属性 。geom line () 产生 试图 连接 所 有 
观察 的 简单 线 : 


> ggplot(data = datas, aes(date time, value, group = type, colour = 
type)) + geom line(size = 0.8) + theme bw() + 
+ labs(x = "Time", y = "Load (kW)", title = "Fit from Multiple Linear 
Regression") 


结果 如 下 : 
1500 类 型 
= 拟 合 值 
T 一 真实 值 
{5 
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之 前 的 linear model 1 图 相 比 拟 合 和 真实 值 更 匹配 。 


绘制 拟 合 值 和 残 差 值 。 


> ggplot(data = data.table(Fitted values = 
linear model 2$fitted.values, Residuals = linear model 2$residuals), 
aes(Fitted values, Residuals)) + geom point(size = 1.7) 

+ geom hline(yintercept = 0, color = "red", size = 1) + 

+ labs(title = "Fitted values vs Residuals") 


结果 如 下 : 


拟 合 值 与 残 差 
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拟 合 值 


与 之 前 的 linear model 1 图 相 比 ， 这 些 点 似乎 更 接近 于 残 差 线 。 
绘制 正 态 Q-Q 图 : 


> ggOO(linear model 2) 


结果 如 下 : 


正 态 Q-Q 图 
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统计 分 位 点 


第 5 步 : 构建 预测 模型 


我 们 可 以 定义 一 个 函数 来 返回 提前 1 周 的 预测 。 输 入 参数 为 data 和 和 set_of_date: 





predWeekReg <- function(data, set of date)t 
#creating the dataset by dates 

data train <- data[date $in$ set of date] 

N «- nrow(data train) 


# number of days in the train set 
window «- N / period # number of days in the train set 


#1, ..., period, 1, ..., period - daily season periods 
#feature "week num"- weekly season 

matrix train «- data.table(Load - data train[, value], 
Daily - as.factor(rep(1:period, window)), 

Weekly - as.factor(data train[, week num])) 


#creating linear model. 
# formula - Load ~ 0 + Daily + Weekly + Daily:Weekly 
# dataset - data = matrix train 
+ lm m «- lm(Load < 0 + Daily + Weekly + Daily:Weekly, data = 
matrix train) 


十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 VV 


十 

+ #forecast of one week ahead 

+ pred week «- predict (1m_m, matrix train[1:(7*period), -1, with = 
FALSE]) 

+ return(as.vector(pred week)) 

* J 


定义 评估 预测 的 平均 绝对 百分比 误差 : 


> mape <- function(real, pred)í( 
+ return(100 * mean(abs((real - pred)/real))) 
*+ 于 


设置 两 星期 长 度 的 训 





练 数 据 集 ， 因 此 总 星期 数 减 去 2， 即 产生 50 周 的 预测 。 使 用 滑动 窗口 万 法 进行 各 种 行业 的 计 





练 预测 : 


> n weeks «- floor(length(n date)/7) - 2 


输出 星期 数 : 


> n weeks 


结果 如 下 : 


[1] 50 


计算 每 个 行业 提前 1 周 的 预测 。 


调用 冰 数 返回 AggData 中 商业 人 资 源 和 数据 集 的 提前 1 周 预 测 : 


> lm pred weeks 1 <- sapply (0: (n weeks-1), function (1) 
+ predWeekReg(AggData[type -- n type[1]], 
n date[((i*7)-41):((i*7)-47*2)])) 


调用 消 数 返回 AggData 中 教育 和 日 期 集 的 提前 1 周 预测 : 


> lm pred weeks 2 <- sapply(0: (n weeks-1), function(i) 
+ predWeekReg(AggData[type == n type[2]], 
n date[((i*7)-41):((i*7)-47*2)])) 


调用 函数 返回 AggData 中 食物 、 销 售 和 日 期 集 的 提前 1 周 预测 : 


> lm pred weeks 3 <- sapply(0:(n weeks-1), function (i) 
+ predWeekReg (AggData[type == n type[3]], 
n date[((i*7)-41):((i*7)-47*2)])) 


调用 水 数 返回 AggData 中 照明 行业 和 日 期 集 的 提前 1 周 预 测 : 


> lm pred weeks 4 «- sapply(0: (n weeks-1), function(i) 
+ predWeekReg(AggData[type == n type[4]], 
n date[((i*7)-41):((i*7)-47*2)])) 


VEEESERRZERP (TV FBEEPIERUIURSSEXSAXJENA EC xZE. AAA PENADE. iFERHHT H&AggDatarPrsl 48 
源 和 数据 集 的 预测 的 误 郑 : 


> lm err mape 1 <- sapply(0: (n weeks-1), function(i) 
+ mape(AggData[(type == n type[1] & date $in$ 

n date[(15-*(i*7)):(21-*(i*7))]), value], 
+ lm pred weeks 1[, 141])) 


输出 数据 框 Im_err mape 1: 
> lm err mape 1 


结果 如 下 : 


[1] 15.651678 11.885790 13.711592 7.216850 5.261544 8.074024 6.046631 5.175894 10.175659 6.573435 7.249069 5.189729 
[13] 3.966611 23.537241 4.517766 4.259040 3.865752 4.564565 4.540562 14.533468 7.091113 60.321064 10.747477 48.175696 
[25] 12.011780 10.181759 29.469939 5.571468 26.054342 5.065741 5.013238 7.510948 4.157744 15.843159 8.724484 7.609050 
[37] 3.712756 3.912121 5.448236 3.866538 3.244851 6.641563 28.244843 38.190629 18.194939 26.481096 26.339300 8.457155 
[49] 11.176872 15.880014 


调用 函数 返回 用 于 评估 AggData 中 教育 和 日 期 集 的 预测 的 平均 绝对 百分比 误差 : 


> lm err mape 2 <- sapply(0: (n_weeks-1), function(i) 
+ mape (AggData[ (type == n type[2] & date sins 

n date[(15-*(i*7)):(21-*(i*7))]), value], 
+ lm pred weeks 2[, i-*1])) 


输出 数据 框 Im_err mape 2: 
> lm err mape 2 


结果 如 下 : 


[1] 10.084345 8.452523 58.100982 10.779631 12.290251 


[13] 12.754905 11.052129 5.624771 6.243265 
[25] 10.921287 8.672482 7.639304 10.006915 
[37] 4.276840 5.329250 11.452156 13.313456 


[49] 10.614472 51.541775 


4.557871 
9. 030679 
9. 835459 


13.748548 13.185274 
7.842977 5.464003 
6.077076 9. 848483 

11.187358 12.744013 


8.708880 13.608198 7.976265 7.786389 22.951015 
9.951756 13.658921 11.571770 7.876418 10.951769 
6.445102 14.021887 14.064280 13.624932 29.057978 
9.460053 34.312551 13.113285 12.155385 28.036420 


调用 函数 返回 用 于 评 佑 AggData 中 食物 、 销 售 和 日 期 集 的 预测 的 平均 绝对 百分比 误差 : 


> lm err mape 3 <- sapply(0: (n weeks-1), 
+ mape (AggData[ (type 


function (i) 


n type[3] & date $in$ 


n date[(15-*(i*7)):(21-*(i*7))]), value], 
+ lm pred weeks 3, 


输出 数据 框 Im_err mape 3: 


> lm err mape 3 


结果 如 下 : 


141])) 


[1] 1.3494435 1.6115792 1.1212235 1.2100342 1.0249229 0.9645256 0.9538736 1.6206521 3.3962925 2.3641598 1.3481740 1. 5083682 
[13] 1.8310301 5.8381717 1.8980476 1.3625701 2.3412257 2.3754512 2.8773237 3.1063138 2.9674816 2.5777905 4.1572684 3.8093668 
[25] 3.5908706 4.2735190 2.3578053 4.5968416 4.0791122 7.9821166 3.2058152 5.3319568 3.2213241 2.9283188 2.6655705 4.7280836 
[37] 5.4562748 2.8417542 6.4128534 2.9900441 3.5614321 4.6741020 3.9244749 3.3571312 1.9261284 2.6419782 2.4853783 2.7261717 


[49] 2.3941716 6.1437349 


调用 函数 返回 用 于 评 佑 AggData 中 照明 行业 和 日 期 集 的 预测 的 平均 绝对 百分比 误差 : 


Ó` 


> lm err mape 4 <- sapply(0: (n weeks-1), 


function (i) 


+ mape(AggData[(type == n type[4] & date $in$ 


n date[(15*(i*7)):(21-*(i*7))]), 
+ lm pred weeks 4[, 


输出 数据 框 Im_err mape 4: 


> lm err mape 4 


结果 如 下 : 


[1] 8.647721 7.375660 
[13] 5.957011 5.871259 
[25] 12.620649 11.001515 
[37] 9.994092 7.129103 
[49] 6.550366 35.256450 


第 6 步 : 绘制 1 年 的 预测 


绘制 结果 : 


(需要 安装 ImageMagick-7.0.4-Q16 才 能 使 saveGIF 工 作 。 ) 


5.463200 
5.924100 
8. 630602 
8.642347 


7.180215 
7.175428 
5.249746 
5.765497 


it1])) 


6.029445 
7.107502 
5.037242 


value], 


5.736619 
6. 602283 
4.541921 


7.846388 13.715063 


8.209645 10.220787 38.049561 7.831923 
5.144848 13.114200 7.087625 29.881252 5.949965 5.529862 
6.132860 11. 573741 10.771706 21.248055 29.164510 15.612347 
9.045185 10.814154 29.182009 12. 573626 12.319590 5.138492 


5.942506 7.537182 


> datas <- data.table(value = c(as.vector(lm pred weeks 1), 

AggData[(type == n type[1]) & (date $in$ n date[-c(1:14,365)]), 
value]), 

date time = c(rep(AggData[-c(1:(14*48), (17473:nrow(AggData))), 
date time], 2)), 

type = c(rep("MLR", nrow(lm pred weeks 1)*ncol(lm pred weeks 1)), 

rep("Real", nrow(lm pred weeks 1)*ncol(1m pred weeks 1))), 

week = c(rep(1:50, each = 336), rep(1:50, each = 336))) 


> saveGIF ({ 


oopt - ani.options(interval - 0.9, nmax - 50) 

for(i in 1:ani.options("nmax"))( 

print(ggplot(data - datas[week -- i], aes(date time, value, group - 
type, colour = type)) + 

geom line(size = 0.8) + 

scale y continuous (limits = c(min(datas[, value]), max(datas[, 


value]))) + 
theme(panel.border = element blank(), panel.background = 
element blank(), 


panel.grid.minor = element line(colour = "grey90"), 
panel.grid.major - element line(colour - "grey90"), 
panel.grid.major.x = element line(colour = "grey90"), 


title - element text(size - 15), 


axis.text = element text (size = 10), 

axis.title = element text(size = 12, face = "bold")) + 

labs(x = "Time", y = "Load (kW)", 

title - paste("Forecast of MLR (", n type[1], "); ", "week: ", i, "; 
MAPE: '', 

round(lm err mape 1[1], 2), "$", sep = ""))) 

ani.pause () 

) 

y), movie.name = "industry 1l.gif", ani.height = 450, ani.width = 750) 


结果 如 下 : 
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上 述 结果 证 明 ， 电 力 消费 模式 是 以 假期 、 天 气 、 财 产 性 质 等 外 部 因素 为 依据 的 。 消 费 模 式 本 质 上 是 随机 的 。 


提示 : 目的 是 向 读者 介绍 多 个 用 于 预测 双 周期 性 时 间 序列 线性 回归 的 应 用 ， 其 用 于 包含 自 变量 的 相互 作用 以 确保 模型 的 有 效 
性 是 非常 有 用 的 。 


